﻿Imports System.Threading
Imports System.Security.Cryptography
Imports System.IO
Imports System.Windows
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.LayerManager
Public Class CLDS_ACAD
    '
    ' R6.10.1   20/05/2012  Original
    ' R6.10.2   06/06/2012  Add support for proxy server authentication
    ' R6.10.4   19/02/2013  Trap errors in CMPIC_Query and hold in CMERR variable
    ' R6.10.5.1 13/05/2013  Allow unencrypted passwords in CMPIC_defaults.xml
    '                       Allow [PROJECTNAME] for Project ID in CMPIC_defaults.xml
    '                       Support MDI, saving palette values in document hash table
    '           14/05/2013  Add CMPIC_ORIGIN block support
    '           16/05/2013  Check existence of node ID in CMPIC when creating new node
    '        .2 10/06/2013  Remove Interop dependency by going directly
    '                       to Registry for project path
    '        .3 12/06/2013  Update device block layers after upload
    '        .4 19/06/2013  Multi-cable and multi-segment displays using new separate horizontal palette
    '                       Labels use project-specific token values
    '                       Vessel and tier references obscured when not relevant to project
    '        .5 29/06/2013  Add segment tier update dialog
    '                       Add node/segment elevation property
    ' 13.06  .1 10/07/2013  Use versioning aligned with CMPIC V9 rule-set
    '                       Check rule-set/DLL version compatibility
    '                       Hide palette when no relevant docments remain open
    '        .2 16/07/2013  Catch eFilerError when node/device block definition not found
    '        .3 24/08/2013  Allow upload of all CMPIC entities or just those which have been changed
    '                       Allow output to XML file instead of upload to CMPIC
    '                       Connect button re-reads CMPIC_Prefs.xml
    '                       Allow point-segment at existing node (upgrades node to point-segment)
    ' 13.09  .1 30/08/2013  Release 13.09
    '        .2 01/09/2013  Rename existing CMPIC_defaults.xml and CMPIC_Prefs.xml before saving to avoid corruption
    '        .3 05/09/2013  Allow spaces when prompting for ID during device block insertion
    '        .4 10/09/2013  Add external acedPostCommand to allow cancellation of Pan mode prior to adding node blocks
    '        .5 12/09/2013  Highlight from/to nodes in same way as required nodes
    '                       Allow update of segment/point-segment ID when leading "-" (stripped on upload)
    ' 13.10  .1 01/10/2013  Transform geometry to/from UCS when adding, drawing  or uploading nodes and devices
    '        .2 07/10/2013  Trap uninitialised API (e.g. after timeout or manual disconnect)
    '        .3 16/10/2013  Try 32-bit and 64-bit acedPostCommand entry points
    '           18/10/2013  Strict sequence XML Nodes, Point-Segments, Segments, Devices
    '                       Suppress XML output of device PartID and Remarks, and node Comments
    '                       Override JUMP type preference from project defaults
    '        .4 21/10/2013  Add multi-cable route, accept, reject and delete operations
    '           04/11/2013  Add network analysis
    '                       Add branch pruning
    '                       Show manual segment eligibility as text in reason column
    '           06/11/2013  Show multi-route using combo-box for rule-set numbers
    '           08/11/2013  Ensure default area, type, segregation set as appropriate when creating nodes,
    '                       point-segments or devices
    '           11/11/2013  Show read-only routing preferences for Autoroute requests
    '                       Cancel pan mode in CLDS_SelectSegment, e.g. when highlighting manual route candidates
    '        .5 12/12/2013  Use ed.CurrentUserCoordinateSystem to decide appropriate WCS2UCS transformation
    '        .6 14/12/2013  Only reason to convert UCS2WCS is after PromptSelectionResult to pick node insertion point. WCS2UCS may never be needed
    ' 13.11  .1 16/12/2013  Treat ruleset "" and ruleset "0" the same
    ' 14.03  .1 02/03/2014  Add Find/Replace tab
    '                       Merge connection and proxy tabs
    '                       Fix XRecord updates
    ' 14.04  .2 26/03/2014  Move upload status label below log
    '        .3 27/03/2014  Allow Batch to be re-actioned if error
    '                       Add API Max Errors preference
    '                       Trap timeout error on API connection
    '                       Fix Replace dialog: was missing out Segregation
    '                       Add segment colour specified by database reference data lookup
    '                       Add node and device block rotation preferences
    '        .4 08/04/2014  Allow cable nodes to be updated to OFF ROUTE or NULL
    '                       Allow update of from/to off-route length
    '                       Ensure device updated when only coordinates change
    '                       Use current selected device and node as cable query criteria (e.g. when near-node selected)
    '        .5 10/04/2014  Add flexible number rules. Nodes only in first instance
    '                       Trap NULL reference exceptions in CLDS_SetNetworkProperties, CLDS_FindNodeAtPosition and CLDS_EraseNetwork
    '        .6 11/04/2014  Update dictionary when nodes or devices renamed
    '                       Add node major/minor in Network/Edit
    '                       Select joined and break nodes as picked during operation
    '                       Add Analysis option on Upload tab
    '                       Prevent analysis check-boxes showing if analysis not enabled on project
    '       .7 14/04/2014   Trap deleted layers in XFilter procedures
    '                       Use XFilter procedure for network validation
    '                       Add segment ID QBE filter on Route tab
    '       .8 17/04/2014   Convert old-style {} rule from preferences into new style
    '                       Support prompt for every node using picture {I}
    '                       Allow edit of length for normal and jump segments
    '                       Add point-segment rule
    ' 14.05 .1 20/04/2014   Add area grouping by hierarchy, block, zone, deck or sub-location
    '                       Add check-box to suppress devices
    '       .2 29/04/2014   Allow network erasure by area group or segregation
    '       .3 02/05/2014   Extend fill/routed/approved highlighting to point-segments
    '                       Add check-box to toggle colour by Reference Data rules
    '       .4 06/05/2014   Highlight full segments in current/auto route list view
    ' 14.07 .1 04/07/2014   Add major node block, layer, colour, scale and rotation preferences
    '                       Ensure type/segregation set when follow polyline in Network/Edit
    '                       Open preferences and connection files read-only
    '                       Add device nodes during rename if both node ID and device ID are renamed
    '                       Add device nodes during upload via BNU or XML
    '       .2 07/07/2014   Ensure major node layer created before network draw commences
    '       .3 10/07/2014   Fix segment rename (only one end renamed when near-node rename required
    '                       Add explicit check-box for near-node rename
    ' 14.10 .1 21/10/2014   Fix CLDS_NextNode when initialising local penetration ID rule
    '                       Support auto-number start value in rule definition
    ' 14.11 .1 12/11/2014   Prevent segment insert upload when type blank or "-"
    '                       Improve palette behaviour in MDI mode
    '                       Hide palette after last relevant drawing closed
    '                       Use pre-selected nodes when joining
    '       .2 25/11/2014   Trap deleted layer in device XFilter procedure
    '                       Enforce network validation prior to upload
    '                       Check for and highlight duplicate nodes during validation
    '                       Reset layers prior to upload, clearing any prior error highlights
    '                       Change interpretation of API Max Errors (x_maxe) so defaults to zero error tolerance
    ' 15.01 .1 06/01/2015   Look for changed segment lengths when validating network
    '          14/01/2015   Support comment attributes in node and device blocks
    ' 15.02 .1 02/02/2015   Remove invalid characters from cable route layer name
    '          09/02/2015   Add trace output to %TEMP%
    '                       Use CLDS_SetLayer for all entity layers
    '
    Public v_no As String = "15.02.1"                           ' Module version (string)
    Public v_verno As Integer = 1502                            ' Module version (numeric)
    Public v_date As String = "9th February 2015"              ' Module date
    Public v_minrs As Integer = 1405                            ' Minimum CMPIC V9 rule-set version
#Region "Private declarations"
    Friend Shared CMAPI As Cloudis.CMAPI_Client = Nothing               ' CMPIC Servlet communications
    Friend Shared CMERR As String = ""                                  ' CMPIC Servlet error
    Friend Shared v_props As CLDS_Drawing_Properties = Nothing          ' CMPIC Servlet communication parameters
    Friend Shared v_prefs As New CLDS_Preferences                       ' Preferences
    Friend Shared p_palette As  _
        Autodesk.AutoCAD.Windows.PaletteSet = Nothing                   ' CMPIC palette set
    Friend Shared p_palguid As _
        New Guid("923EBCE8-03D0-4a98-B481-430D1D29F5F3")                ' CMPIC palette GUID
    Friend Shared p_hzpalette As  _
        Autodesk.AutoCAD.Windows.PaletteSet = Nothing                   ' CMPIC horizontal palette set
    Friend Shared p_hzpalguid As _
        New Guid("830A38A2-043C-48b5-89F1-8CBE59883C5E")                ' CMPIC horizontal palette GUID
    Friend Shared p_condialog As CLDS_Connection_Container = Nothing    ' CMPIC connection dialog
    Friend Shared p_netdialog As CLDS_Network_Container = Nothing       ' CMPIC network dialog
    Friend Shared p_segdialog As CLDS_Segment_Container = Nothing       ' CMPIC segment dialog
    Friend Shared p_rtedialog As CLDS_Route_Container = Nothing         ' CMPIC route dialog
    Friend Shared p_mcbdialog As CLDS_Multirow_Container = Nothing ' CMPIC multi-cable dialog
    Friend Shared p_currdocs As Document = Nothing

    Private x_udkey As String = "CLDS_Document_Data"                    ' Document UserData HashTable key

    Private b_table As Collection = Nothing                             ' Cache block table records
    Private tokens As Collection = Nothing

    Private cmpic_x As Double                                           ' Origin X in CMPIC coordinates
    Private cmpic_y As Double                                           ' Origin Y in CMPIC coordinates
    Private local_x As Double                                           ' Origin X in drawing coordinates
    Private local_y As Double                                           ' Origin X in drawing coordinates
    Private local_a As Double                                           ' Drawing rotation relative to project coordinate system

    Private f_DISCARD As Integer = 1                                    ' Routing option bit values
    Private f_ACCEPT As Integer = 2
    Private f_BREAKS As Integer = 4
    Private f_RETAIN As Integer = 8
    Private f_REVERSE As Integer = 16
    Private f_PARTIAL As Integer = 32
    Private f_ASTAR As Integer = 64
    Private f_SPS As Integer = 128
    Private f_BULK As Integer = 256
    Private f_SHOWNODES As Integer = 512
    Private f_ANALYSIS As Integer = 1024
    Private f_PSTIER As Integer = 2048

    Private C_LOCKS As Integer = 1                              ' Rule suppression bit values
    Private C_MBR As Integer = 2
    Private C_HOT As Integer = 4
    Private C_REQD As Integer = 8
    Private C_SEG As Integer = 16
    Private C_MAXMIN As Integer = 32
    Private C_EXIST As Integer = 64
    Private C_PROHIB As Integer = 128
    Private C_ZONE As Integer = 256
    Private C_ISOL As Integer = 512
    Private C_SPS As Integer = 1024
    Private C_AROUTE As Integer = 2048
    Private C_PARTIAL As Integer = 4096

    Public R_DSNR As Integer = 0                                ' Route status codes
    Public R_DRCNA As Integer = 25
    Public R_DRCA As Integer = 30

    Private a_net As ArrayList = Nothing                        ' Array list of selected network entities

    Private v_varies As String = "*VARIES*"                     ' Denotes conflicting values in multiple object selection

    Private mUCSWCS As Matrix3d                                 ' UCS->WCS transformation matrix
    Private bUCSWCS As Boolean = False                          ' True when mUCSWCS valid
    Private mWCSUCS As Matrix3d                                 ' WCS->UCS transformation matrix
    Private bWCSUCS As Boolean = False                          ' True when mWCSUCS valid

    Private uColour As New System.Collections.Generic.Dictionary(Of Integer, String)                     ' Flag multi-colour items in use
    Private uMulti As New System.Collections.Generic.Dictionary(Of Integer, CLDS_AR_Multi)

    Private nRule As CLDS_Flex_Format = Nothing                 ' Node ID rule
    Private pRule As CLDS_Flex_Format = Nothing                 ' Point-segment rule
    Private dRule As CLDS_Flex_Format = Nothing                 ' Device ID rule
    Private rRule As CLDS_Flex_Format = Nothing                 ' Raceway number rule
    Private sRule As CLDS_Flex_Format = Nothing                 ' Segment ID rule

#End Region
#Region "Properties"
    Public ReadOnly Property pCMAPI() As Cloudis.CMAPI_Client
        Get
            Return CMAPI
        End Get
    End Property
    Public Property pCMERR() As String
        Get
            Return CMERR
        End Get
        Set(ByVal value As String)
            CMERR = value
        End Set
    End Property
    Public Property pProps() As CLDS_Drawing_Properties
        Get
            Return v_props
        End Get
        Set(ByVal value As CLDS_Drawing_Properties)
            v_props = value
        End Set
    End Property
    Public Property pPrefs() As CLDS_Preferences
        Get
            Return v_prefs
        End Get
        Set(ByVal value As CLDS_Preferences)
            v_prefs = value
        End Set
    End Property
    Public ReadOnly Property pPalette() As Autodesk.AutoCAD.Windows.PaletteSet
        Get
            Return p_palette
        End Get
    End Property
    Public ReadOnly Property pHzPalette() As Autodesk.AutoCAD.Windows.PaletteSet
        Get
            Return p_hzpalette
        End Get
    End Property
    Public Property pConDialog() As CLDS_Connection_Container
        Get
            Return p_condialog
        End Get
        Set(ByVal value As CLDS_Connection_Container)
            p_condialog = value
        End Set
    End Property
    Public Property pNetDialog() As CLDS_Network_Container
        Get
            Return p_netdialog
        End Get
        Set(ByVal value As CLDS_Network_Container)
            p_netdialog = value
        End Set
    End Property
    Public Property pSegDialog() As CLDS_Segment_Container
        Get
            Return p_segdialog
        End Get
        Set(ByVal value As CLDS_Segment_Container)
            p_segdialog = value
        End Set
    End Property
    Public Property pRouteDialog() As CLDS_Route_Container
        Get
            Return p_rtedialog
        End Get
        Set(ByVal value As CLDS_Route_Container)
            p_rtedialog = value
        End Set
    End Property
    Public Property pMultiCabDialog() As CLDS_Multirow_Container
        Get
            Return p_mcbdialog
        End Get
        Set(ByVal value As CLDS_Multirow_Container)
            p_mcbdialog = value
        End Set
    End Property
    Public Property VersionStr() As String
        Get
            Return v_no
        End Get
        Set(ByVal value As String)
            v_no = value
        End Set
    End Property
    Public Property VersionNo() As Integer
        Get
            Return v_verno
        End Get
        Set(ByVal value As Integer)
            v_verno = value
        End Set
    End Property
    Public Property VersionDate() As String
        Get
            Return v_date
        End Get
        Set(ByVal value As String)
            v_date = value
        End Set
    End Property
    Public Property MinRSNo() As Integer
        Get
            Return v_minrs
        End Get
        Set(ByVal value As Integer)
            v_minrs = value
        End Set
    End Property
    Public Property BlockCache() As Collection
        Get
            Return b_table
        End Get
        Set(ByVal value As Collection)
            b_table = value
        End Set
    End Property
    Public ReadOnly Property pTokens() As Collection
        Get
            Return tokens
        End Get
    End Property
    Public Property X_CMPIC() As Double
        Get
            Return cmpic_x
        End Get
        Set(ByVal value As Double)
            cmpic_x = value
        End Set
    End Property
    Public Property Y_CMPIC() As Double
        Get
            Return cmpic_y
        End Get
        Set(ByVal value As Double)
            cmpic_y = value
        End Set
    End Property
    Public Property X_LOCAL() As Double
        Get
            Return local_x
        End Get
        Set(ByVal value As Double)
            local_x = value
        End Set
    End Property
    Public Property Y_LOCAL() As Double
        Get
            Return local_y
        End Get
        Set(ByVal value As Double)
            local_y = value
        End Set
    End Property
    Public Property A_LOCAL() As Double
        Get
            Return local_a
        End Get
        Set(ByVal value As Double)
            local_a = value
        End Set
    End Property
    Public ReadOnly Property M_RULESET() As System.Collections.Generic.Dictionary(Of Integer, CLDS_AR_Multi)
        Get
            Return uMulti
        End Get
    End Property
    Public ReadOnly Property pNRule() As CLDS_Flex_Format
        Get
            Return nRule
        End Get
    End Property
#End Region
#Region "External functions"
#If CLDS_ACAD_V = "2010" Then
    Declare Auto Function acedPostCommand Lib "acad.exe" _
     Alias "?acedPostCommand@@YAHPB_W@Z" _
     (ByVal strExpr As String) As Integer
    Declare Auto Function acedPostCommand64 Lib "acad.exe" _
     Alias "?acedPostCommand@@YAHPEB_W@Z" _
     (ByVal strExpr As String) As Integer
#Else
    Declare Auto Function acedPostCommand Lib "accore.dll" _
     Alias "?acedPostCommand@@YAHPB_W@Z" _
     (ByVal strExpr As String) As Integer
    Declare Auto Function acedPostCommand64 Lib "accore.dll" _
     Alias "?acedPostCommand@@YAHPEB_W@Z" _
     (ByVal strExpr As String) As Integer
#End If
#End Region
#Region "V9 communications"
    Public Sub CLDS_InitialiseConnection()
        CMAPI = Nothing
    End Sub
    Public Function CLDS_URLConnection _
        (Optional ByVal p_init As Boolean = False) _
         As Boolean
        If p_init Then
            CLDS_InitialiseConnection()
        End If

        If CMAPI Is Nothing Then
            CMAPI = New Cloudis.XCMAPI_Client
        End If

        Dim nc As System.Net.NetworkCredential
        If (v_props.v_pruser = "" Or v_props.v_prpass = "") Then
            nc = Nothing
        Else
            nc = New System.Net.NetworkCredential(v_props.v_pruser, v_props.v_prpass)
        End If
        CMAPI.SessionID = ""
        If Not (v_props.v_url = "" Or v_props.v_userid = "" Or v_props.v_passwd = "") Then
            CMAPI.OpenSession(v_props.v_url, v_props.v_userid, v_props.v_passwd, "OPEN", nc)
        End If

        'If CMAPI.SessionID = "" Then
        'CMAPI.ShowConnect(v_props.v_url, v_props.v_userid, "OPEN", nc)
        'End If

        If CMAPI.SessionID = "" Then
            CLDS_DropConnection()
            CLDS_URLConnection = False
            Exit Function
        End If
        CMAPI.CMProjid = v_props.v_projid
        CMAPI.CMPOwner = v_props.v_powner
        CMAPI.CMApplicability = v_props.v_appl
        CMAPI.CMSource = v_props.v_source
        CMAPI.DebugURL = "N"
        CLDS_URLConnection = True
    End Function
    Public Sub CLDS_DropConnection()
        If Not CMAPI Is Nothing AndAlso CMAPI.SessionID <> "" Then
            Try
                CMAPI.CloseSession()
            Catch ex As Exception
            End Try
        End If
        CMAPI = Nothing
    End Sub
    Public Function CLDS_Query(ByVal ed As Editor, _
                               ByVal i As Integer, _
                               ByVal context As String, _
                               ByVal require As String, _
                               ByVal id As String, _
                               ByRef out(,) As String, _
                               ByRef cc As Collection, _
                               Optional ByVal vessel As Integer = 0) _
                               As Integer
        Dim r As String
        Dim nr As Integer, nc As Integer
        Dim ap As String
        If CMAPI Is Nothing Then
            CMERR = "ERROR: not connected to CMPIC database"
            If ed Is Nothing Then
                MsgBox(CMERR, MsgBoxStyle.Critical, "CMPIC")
            Else
                ed.WriteMessage(vbLf & "[" & context & "." & require & "] " & CMERR & vbLf)
            End If
            Return -1
        End If
        If vessel = 0 Then
            ap = CMAPI.CMApplicability
        Else
            ap = Trim(Str$(Math.Pow(2, (vessel - 1))))
        End If
        CMERR = ""
        If i = 1 Then
            r = CMAPI.QueryCMPIC(ap, context, require, id, out, nr, nc)
        Else
            r = CMAPI.QueryCMPIC(ap, context, "-", "-", out, nr, nc)
        End If
        If Left$(r, 5) = "ERROR" Then
            CMERR = r
            If ed Is Nothing Then
                MsgBox(CMERR, MsgBoxStyle.Critical, "CMPIC")
            Else
                ed.WriteMessage(vbLf & "[" & context & "." & require & "] " & CMERR & vbLf)
            End If
            Return -1
        End If
        If nr = 0 Then
            Return 0
        End If
        If out(0, 1) = "ERROR" Then
            CMERR = out(0, 1) & ":" & out(1, 1)
            If ed Is Nothing Then
                MsgBox(CMERR, MsgBoxStyle.Critical, "CMPIC")
            Else
                ed.WriteMessage(vbLf & "[" & context & "." & require & "] " & CMERR)
            End If
            Return -1
        End If
        If i = 1 Then
            cc = New Collection
            For j As Integer = 0 To nc - 1
                cc.Add(j, out(j, 0))
            Next
        End If
        Return nr
    End Function
#End Region
#Region "Project functions"
    Public Function CLDS_CheckCompatibility() As Boolean
        Dim rsno As Integer = Val(tokens("PD_RULESET"))
        Dim mindll As Integer = Val(tokens("PD_MINDLL"))
        If v_verno = rsno Then
            Return True
        End If
        If rsno > v_verno Then
            If v_verno >= mindll Then
                Return True
            Else
                MsgBox("Incompatible DLL and V9 versions" & Chr(10) & _
                        "V9 version:  " & Trim(Str$(rsno)) & Chr(10) & _
                        "DLL version: " & Trim(Str$(v_verno)) & _
                        ", need at least " & Trim(Str$(mindll)), _
                        MsgBoxStyle.Critical, "CMPIC V9 Compatibility Check")
            End If
        End If
        If v_verno > rsno Then
            If rsno >= v_minrs Then
                Return True
            Else
                MsgBox("Incompatible DLL and V9 versions" & Chr(10) & _
                        "DLL version: " & Trim(Str$(v_verno)) & Chr(10) & _
                        "V9 version:  " & Trim(Str$(rsno)) & _
                        ", need at least " & Trim(Str$(v_minrs)), _
                        MsgBoxStyle.Critical, "CMPIC V9 Compatibility Check")

            End If
        End If
        Return False
    End Function
    Public Function CLDS_GetRule(ByVal p_ed As Editor, ByVal p_id As String, ByVal p_dflt As String) As CLDS_Flex_Format
        Dim ff As CLDS_Flex_Format = Nothing
        Dim rc(,) As String
        Dim rcc As Collection = Nothing
        Dim nr As Integer = CLDS_Query(p_ed, 1, "PR", "RU", p_id, rc, rcc)
        If nr <= 0 Then
            ff = New CLDS_Flex_Format(p_dflt)
            Return ff
        End If
        Dim ru_code As String
        Dim ru_picture As String
        Dim ru_component As Integer
        Dim ru_title As String
        Dim ru_comments As String
        For r As Integer = 1 To nr - 1
            ru_code = rc(rcc("RU_CODE"), r)
            ru_picture = rc(rcc("RU_PICTURE"), r)
            ru_component = Val(rc(rcc("RU_COMPONENT"), r))
            ru_title = rc(rcc("RU_TITLE"), r)
            ru_comments = rc(rcc("RU_COMMENTS"), r)
            If r = 1 Then
                ff = New CLDS_Flex_Format(ru_picture, ru_code)
                ' pPrefs.r_node = "* " & ru_picture & " from CMPIC rule " & ru_code & " *"
            End If
            If InStr(ru_comments, "|") = 2 Then
                Dim t As String = Mid$(ru_comments, 1, 1)
                ff.Token(ru_component) = t
                If UCase(t) = t Then
                    ff.IsKey(ru_component) = True
                Else
                    ff.IsKey(ru_component) = False
                End If
                ru_comments = Mid$(ru_comments, 3)
            End If
            If ff.Token(ru_component) = "N" Then
                If InStr(ru_title, "|") > 0 Then
                    Dim n As Integer = Val(Mid$(ru_title, InStr(ru_title, "|") + 1))
                    ff.StartNo = n
                    ru_title = Mid$(ru_title, 1, InStr(ru_title, "|") - 1)
                End If
            End If
            If Mid$(ff.Prompt(ff.Token(ru_component)), 1, 5) = "Field" Then
                ff.Prompt(ff.Token(ru_component)) = ru_title
            End If
            ff.Valid(ff.Token(ru_component)) = ru_comments
        Next
        Return ff
    End Function
    Public Sub CLDS_GetProjectDefaults()
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim id As String = ""
        If tokens Is Nothing Then
            tokens = New Collection
        End If
        tokens.Clear()
        Dim nr As Integer = CLDS_Query(ed, 1, "PR", "PD", id, sc, scc)
        If nr <= 0 Then
            System.Diagnostics.Trace.TraceWarning("Project defaults query returned no rows")
            System.Diagnostics.Trace.Flush()
            Exit Sub
        End If
        CMAPI.CMUnits = Val(sc(scc("PD_NUMVESSELS"), 1))
        CMAPI.CMUnitdesc = sc(scc("PD_UNITDESC"), 1)
        tokens.Add(sc(scc("PD_UNITDESC"), 1), "PD_UNITDESC")
        tokens.Add(sc(scc("PD_CTNAME"), 1), "PD_CTNAME")
        tokens.Add(sc(scc("PD_LOCNAME"), 1), "PD_LOCNAME")
        tokens.Add(sc(scc("PD_LENUOM"), 1), "PD_LENUOM")
        tokens.Add(sc(scc("PD_PSNAME"), 1), "PD_PSNAME")
        tokens.Add(sc(scc("PD_SGNAME"), 1), "PD_SGNAME")
        tokens.Add(sc(scc("PD_SGSHORT"), 1), "PD_SGSHORT")
        tokens.Add(sc(scc("PD_SYSNAME"), 1), "PD_SYSNAME")
        tokens.Add(sc(scc("PD_MULTITIER"), 1), "PD_MULTITIER")
        If scc.Contains("PD_RULESET") Then
            tokens.Add(sc(scc("PD_RULESET"), 1), "PD_RULESET")
            tokens.Add(sc(scc("PD_MINDLL"), 1), "PD_MINDLL")
        Else
            tokens.Add("1304", "PD_RULESET")
            tokens.Add("1304", "PD_MINDLL")
        End If
        If scc.Contains("PD_YNRWAY") Then
            tokens.Add(sc(scc("PD_YNRWAY"), 1), "PD_YNRWAY")
        Else
            tokens.Add("N", "PD_YNRWAY")
        End If
        If scc.Contains("PD_JUMPTYPE") Then
            Dim j As String = sc(scc("PD_JUMPTYPE"), 1)
            If j = "" Then
                j = pPrefs.n_jump
            Else
                pPrefs.n_jump = j
            End If
            tokens.Add(j, "PD_JUMPTYPE")
        End If
        If scc.Contains("PD_ANALYSIS") Then
            tokens.Add(sc(scc("PD_ANALYSIS"), 1), "PD_ANALYSIS")
        Else
            tokens.Add("N", "PD_ANALYSIS")
        End If
        If CLDS_CheckCompatibility() Then
            pPrefs.x_v9st = tokens("PD_RULESET")
        Else
            tokens.Clear()
            Exit Sub
        End If
        nRule = CLDS_GetRule(ed, "EDIT.NODEID", pPrefs.r_node)
        'If nRule.UfmCode <> "" Then
        'pPrefs.r_node = "* " & nRule.Picture & " from CMPIC rule " & nRule.UfmCode & " *"
        'End If
        pRule = CLDS_GetRule(ed, "EDIT.PSEGID", pPrefs.r_pseg)
        If pRule.NoFields = 0 Then
            pRule = nRule
            'Else
            'If pRule.UfmCode <> "" Then
            'pPrefs.r_pseg = "* " & pRule.Picture & " from CMPIC rule " & pRule.UfmCode & " *"
            'End If
        End If
        System.Diagnostics.Trace.TraceInformation("V9 rule-set version " & tokens("PD_RULESET"))
        System.Diagnostics.Trace.Flush()
    End Sub
#End Region
#Region "Block functions"
    Public Function CLDS_FindBlock(ByVal p_bt As BlockTable, _
                                  ByVal p_doc As Document, _
                                  ByVal p_name As String) _
                                  As ObjectId
        Dim nBlock As ObjectId
        If b_table Is Nothing Then
            b_table = New Collection
        End If
        If b_table.Contains(p_name) Then
            nBlock = b_table.Item(p_name)
            Return nBlock
        End If
        If Not p_bt.Has(p_name) Then
            Dim XFN As String
            Try
                XFN = HostApplicationServices.Current.FindFile(p_name & ".dwg", p_doc.Database, FindFileHint.Default)
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                If ex.ErrorStatus = ErrorStatus.FilerError Then
                    XFN = ""
                End If
            End Try
            If XFN = "" Then
                p_doc.Editor.WriteMessage(vbLf & p_name & " block not found")
                nBlock = ObjectId.Null
            Else
                Dim xDB As Database = New Database(False, True)
                Try
                    xDB.ReadDwgFile(XFN, FileOpenMode.OpenForReadAndReadShare, True, "")
                    nBlock = p_doc.Database.Insert(p_name, xDB, True)
                Catch ex As Exception
                    p_doc.Editor.WriteMessage(vbLf & "Unable to load " & p_name & " block" & vbLf & ex.ToString)
                    nBlock = ObjectId.Null
                End Try
            End If
        Else
            nBlock = p_bt(p_name)
        End If
        If Not nBlock.IsNull Then
            b_table.Add(nBlock, p_name)
        End If
        CLDS_FindBlock = nBlock
    End Function
    Public Sub CLDS_CloneBlock(ByVal p_trans As Transaction, _
                          ByVal p_doc As Document, _
                          ByVal p_name As String, _
                          ByVal p_old As ObjectId, _
                          ByVal p_new As BlockReference)
        Dim btrec As BlockTableRecord = DirectCast(p_trans.GetObject(p_old, OpenMode.ForRead), BlockTableRecord)
        If String.IsNullOrEmpty(btrec.Name) Then
            btrec.UpgradeOpen()
            btrec.Name = p_name
            btrec.DowngradeOpen()
        End If
        If btrec.HasAttributeDefinitions Then
            For Each aoid As ObjectId In btrec
                Dim ent As Entity = DirectCast(aoid.GetObject(OpenMode.ForRead), Entity)
                Dim ad As AttributeDefinition = TryCast(ent, AttributeDefinition)
                If ad IsNot Nothing Then
                    Dim ar As AttributeReference = New AttributeReference()
                    ar.SetPropertiesFrom(ad)
                    ar.Visible = ad.Visible
                    ar.SetAttributeFromBlock(ad, p_new.BlockTransform)
                    ar.HorizontalMode = ad.HorizontalMode
                    ar.VerticalMode = ad.VerticalMode
                    'ar.Rotation = ad.Rotation
                    ar.Tag = ad.Tag
                    ar.FieldLength = ad.FieldLength
                    ar.TextString = ad.TextString
                    ar.AdjustAlignment(p_doc.Database)
                    p_new.AttributeCollection.AppendAttribute(ar)
                    p_trans.AddNewlyCreatedDBObject(ar, True)
                End If
            Next
        End If

    End Sub
    Public Sub CLDS_SetBlockAttr(ByVal p_br As BlockReference, _
                                 ByVal p_tag As String, _
                                 ByVal p_value As String)
        Dim v As String
        If String.IsNullOrEmpty(p_value) Then
            v = ""
        Else
            v = p_value
        End If
        For Each aoid As ObjectId In p_br.AttributeCollection
            Dim ar As AttributeReference = DirectCast(aoid.GetObject(OpenMode.ForRead), AttributeReference)
            If ar.Tag = p_tag Then
                ar.UpgradeOpen()
                ar.TextString = v
                Exit For
            End If
        Next
    End Sub
    Public Function CLDS_GetBlockAttr(ByVal p_br As BlockReference, _
                                     ByVal p_tag As String) _
                                     As String
        CLDS_GetBlockAttr = ""
        For Each aID As ObjectId In p_br.AttributeCollection
            Dim a As AttributeReference = DirectCast(aID.GetObject(OpenMode.ForRead), AttributeReference)
            If a.Tag = p_tag Then
                If String.IsNullOrEmpty(a.TextString) Then
                    CLDS_GetBlockAttr = ""
                Else
                    CLDS_GetBlockAttr = a.TextString
                End If
                Exit Function
            End If
        Next
    End Function
#End Region
#Region "Layer functions"
    Public Function CLDS_OKLayerName(ByVal p_layer As String) As String
        Dim l As String = p_layer
        Dim c() As String = {"<", ">", "/", "\", """", ":", ";", "?", "*", "|", "=", "‘"}
        For i As Integer = 0 To UBound(c)
            l = Replace(l, c(i), "_", 1, -1, CompareMethod.Text)
        Next
        Return l
    End Function
    Public Sub CLDS_SetLayer(ByVal p_ent As Autodesk.AutoCAD.DatabaseServices.Entity, ByVal p_layer As String, Optional ByVal p_id As String = "")
        Try
            If Not p_ent.IsWriteEnabled Then
                p_ent.UpgradeOpen()
            End If
            p_ent.Layer = p_layer
        Catch ex As Exception
            Dim et As String
            If p_id = "" Then
                et = "entity " & p_ent.Database.GetType.ToString
            Else
                et = p_id
            End If
            System.Diagnostics.Trace.TraceError("Unable to set layer " & p_layer & " for " & et)
            System.Diagnostics.Trace.Flush()
        End Try
    End Sub
    Public Function CLDS_LayerGroup() As LayerGroup
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim lfc As LayerFilterCollection = db.LayerFilters.Root.NestedFilters
        Dim lg As LayerGroup = Nothing
        For Each xlg As LayerFilter In lfc
            If xlg.Name = pPrefs.g_clds Then
                lg = xlg
                Exit For
            End If
        Next
        Return lg
    End Function
    Public Sub CLDS_DeleteLayer(ByVal p_trans As Transaction, _
                               ByVal p_doc As Document, _
                               ByVal p_layer As String)
        Dim lt As LayerTable = DirectCast(p_trans.GetObject(p_doc.Database.LayerTableId, OpenMode.ForRead), LayerTable)
        If lt.Has(p_layer) Then
            Dim ltr As LayerTableRecord = DirectCast(p_trans.GetObject(lt.Item(p_layer), OpenMode.ForWrite), LayerTableRecord)
            ltr.Erase()
        End If
    End Sub
    Public Sub CLDS_CheckLayer(ByVal p_trans As Transaction, _
                               ByVal p_doc As Document, _
                               ByVal p_layer As String, _
                               ByVal p_colour As Autodesk.AutoCAD.Colors.Color, _
                               Optional ByVal p_hide As Boolean = False)
        Dim lt As LayerTable = DirectCast(p_trans.GetObject(p_doc.Database.LayerTableId, OpenMode.ForRead), LayerTable)
        If Not lt.Has(p_layer) Then
            System.Diagnostics.Trace.TraceInformation("Adding layer " & p_layer & " colour " & p_colour.ToString)
            System.Diagnostics.Trace.Flush()
            Dim ltr As LayerTableRecord = New LayerTableRecord()
            ltr.Name = p_layer
            ltr.Color = p_colour
            ltr.IsOff = p_hide
            lt.UpgradeOpen()
            Dim nLayer As ObjectId = lt.Add(ltr)
            lt.DowngradeOpen()
            p_trans.AddNewlyCreatedDBObject(ltr, True)
            Dim lft As LayerFilterTree = nLayer.Database.LayerFilters
            Dim lfc As LayerFilterCollection = lft.Root.NestedFilters
            Dim lg As LayerGroup = Nothing
            For Each xlg As LayerFilter In lfc
                If xlg.Name = pPrefs.g_clds Then
                    lg = xlg
                    Exit For
                End If
            Next
            If lg Is Nothing Then
                lg = New LayerGroup
                lg.Name = pPrefs.g_clds
                lg.LayerIds.Add(nLayer)
                lfc.Add(lg)
                nLayer.Database.LayerFilters = lft
            Else
                lg.LayerIds.Add(nLayer)
                nLayer.Database.LayerFilters = lft
            End If
        Else
            Dim xtr As LayerTableRecord = DirectCast(p_trans.GetObject(lt(p_layer), OpenMode.ForRead), LayerTableRecord)
            If Not xtr.Color.Equals(p_colour) Then
                xtr.UpgradeOpen()
                xtr.Color = p_colour
                xtr.DowngradeOpen()
            End If
        End If

    End Sub
    Public Sub CLDS_CheckLayer(ByVal p_trans As Transaction, _
                            ByVal p_doc As Document, _
                            ByVal p_layer As String, _
                            Optional ByVal p_red As Byte = 255, _
                            Optional ByVal p_green As Byte = 255, _
                            Optional ByVal p_blue As Byte = 255, _
                            Optional ByVal p_hide As Boolean = False)
        Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromRgb(p_red, p_green, p_blue)
        CLDS_CheckLayer(p_trans, p_doc, p_layer, c, p_hide)
    End Sub
    Public Sub CLDS_CheckLayer(ByVal p_trans As Transaction, _
                            ByVal p_doc As Document, _
                            ByVal p_layer As String, _
                            ByVal p_scolour As System.Drawing.Color, _
                            Optional ByVal p_hide As Boolean = False)
        Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromColor(p_scolour)
        CLDS_CheckLayer(p_trans, p_doc, p_layer, c, p_hide)
    End Sub
    Public Sub CLDS_ColourLayer(ByVal p_trans As Transaction, ByVal p_doc As Document, ByVal p_layer As String, ByVal p_scolour As System.Drawing.Color)
        Dim lt As LayerTable = DirectCast(p_trans.GetObject(p_doc.Database.LayerTableId, OpenMode.ForRead), LayerTable)
        If lt.Has(p_layer) Then
            Dim xtr As LayerTableRecord = DirectCast(p_trans.GetObject(lt(p_layer), OpenMode.ForRead), LayerTableRecord)
            Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromColor(p_scolour)
            If Not xtr.Color.Equals(c) Then
                xtr.UpgradeOpen()
                xtr.Color = c
                xtr.DowngradeOpen()
            End If
        End If
    End Sub
    Public Sub CLDS_ColourLayerByPrefs()
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using lTrans As Transaction = doc.TransactionManager.StartTransaction
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_appd, pPrefs.c_appd)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_arte, pPrefs.c_arte)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_crte, pPrefs.c_crte)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_dele, pPrefs.c_dele)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_offr, pPrefs.c_offr)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_brek, pPrefs.c_brek)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_dvce, pPrefs.c_dvce)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_eror, pPrefs.c_eror)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_hide, pPrefs.c_hide)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_isrt, pPrefs.c_isrt)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_jump, pPrefs.c_jump)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_node, pPrefs.c_node)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_nodm, pPrefs.c_nodm)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_sgmt, pPrefs.c_sgmt)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_used, pPrefs.c_used)
                CLDS_ColourLayer(lTrans, doc, pPrefs.l_warn, pPrefs.c_warn)
                lTrans.Commit()
            End Using
        End Using
    End Sub
    Public Function CLDS_ErrorLayer(ByVal p_main As String, ByVal p_mssg As String, Optional ByVal p_action As String = "") As String
        CLDS_ErrorLayer = p_main
        Dim l As Integer, r As Integer
        l = InStr(p_mssg, "[")
        If l = 0 Then
            Exit Function
        End If
        r = InStr(p_mssg, "]")
        If r < l Then
            Exit Function
        End If
        Dim n As String = Mid(p_mssg, l + 1, r - l - 1)
        If p_action = "" Then
            CLDS_ErrorLayer = p_main & "_" & n
        Else
            CLDS_ErrorLayer = p_main & "_" & p_action & "_" & n
        End If
    End Function
#End Region
#Region "Dictionary and XRecord functions"
    Public Function CLDS_GetDictionary(ByVal db As Database, _
                                         ByVal dTrans As Transaction, _
                                         Optional ByVal reset As Boolean = False) _
                                         As DBDictionary
        Dim noDict As DBDictionary = DirectCast(dTrans.GetObject(db.NamedObjectsDictionaryId, OpenMode.ForRead), DBDictionary)
        Dim nDict As DBDictionary
        Try
            nDict = DirectCast(dTrans.GetObject(noDict.GetAt(pPrefs.d_node), OpenMode.ForWrite), DBDictionary)
            If reset Then
                For Each entry As DBDictionaryEntry In nDict
                    nDict.Remove(entry.Key)
                Next
            End If
        Catch ex As Exception
            noDict.UpgradeOpen()
            nDict = New DBDictionary()
            noDict.SetAt(pPrefs.d_node, nDict)
            dTrans.AddNewlyCreatedDBObject(nDict, True)
        End Try
        CLDS_GetDictionary = nDict
    End Function
    Public Sub CLDS_DumpDictionary(ByVal dTrans As Transaction, ByVal nDict As DBDictionary, ByVal ed As Editor)
        ed.WriteMessage(vbCrLf & "Extension dictionary size " & nDict.Count)
        For Each lEntry As DBDictionaryEntry In nDict
            ed.WriteMessage(vbCrLf & lEntry.Key)
            Dim xr As Xrecord = DirectCast(dTrans.GetObject(lEntry.Value, OpenMode.ForRead), Xrecord)
            Dim tv As TypedValue() = xr.Data.AsArray
            For i As Integer = tv.GetLowerBound(0) To tv.GetUpperBound(0)
                ed.WriteMessage(" " & tv(i).ToString)
            Next
        Next
        ed.WriteMessage(vbCrLf & "Command: ")
    End Sub
    Public Sub CLDS_DumpXDictionary(ByVal dTrans As Transaction, ByVal dObj As DBObject, ByVal ed As Editor)
        Try
            Dim xDict As DBDictionary = DirectCast(dTrans.GetObject(dObj.ExtensionDictionary, OpenMode.ForRead), DBDictionary)
            CLDS_DumpDictionary(dTrans, xDict, ed)
        Catch ex As Exception
            CLDS_Static_Utils.CLDS_WriteMessage(ed, "No extension dictionary found")
        End Try
    End Sub
    Public Function CLDS_GetXRecord(ByVal dTrans As Transaction, ByVal dObj As DBObject) As ResultBuffer
        Try
            Dim xDict As DBDictionary = DirectCast(dTrans.GetObject(dObj.ExtensionDictionary, OpenMode.ForRead), DBDictionary)
            Dim xr As Xrecord = TryCast(dTrans.GetObject(xDict.GetAt(pPrefs.d_xrec), OpenMode.ForRead), Xrecord)
            If xr Is Nothing Then
                CLDS_GetXRecord = Nothing
            Else
                CLDS_GetXRecord = xr.Data
            End If
        Catch ex As Exception
            CLDS_GetXRecord = Nothing
        End Try
    End Function
    Public Function CLDS_GetBreakXRecord(ByVal dTrans As Transaction, ByVal dObj As DBObject) As ResultBuffer
        Try
            Dim xDict As DBDictionary = DirectCast(dTrans.GetObject(dObj.ExtensionDictionary, OpenMode.ForRead), DBDictionary)
            Dim xr As Xrecord = TryCast(dTrans.GetObject(xDict.GetAt(pPrefs.d_brek), OpenMode.ForRead), Xrecord)
            If xr Is Nothing Then
                CLDS_GetBreakXRecord = Nothing
            Else
                CLDS_GetBreakXRecord = xr.Data
            End If
        Catch ex As Exception
            CLDS_GetBreakXRecord = Nothing
        End Try
    End Function
    Public Function CLDS_FindNodeAtPosition(ByVal nTrans As Transaction, _
                                  ByVal nDict As DBDictionary, _
                                  ByVal nWCSPos As Point3d) _
                                  As BlockReference
        CLDS_FindNodeAtPosition = Nothing
        For Each lEntry As DBDictionaryEntry In nDict
            If Mid$(lEntry.Key, 1, 5) = "NODE_" Then
                Try
                    Dim xr As Xrecord = DirectCast(nTrans.GetObject(lEntry.Value, OpenMode.ForRead), Xrecord)
                    If Not (xr.IsDisposed Or xr.IsErased) Then
                        Dim rb As ResultBuffer = xr.Data
                        If Not rb Is Nothing AndAlso Not rb.IsDisposed Then
                            Dim tv As TypedValue() = rb.AsArray
                            Dim hn As Handle = New Handle(tv(0).Value)
                            Dim x As ObjectId = nDict.Database.GetObjectId(False, hn, 0)
                            Dim br As BlockReference = TryCast(nTrans.GetObject(x, OpenMode.ForRead), BlockReference)
                            If Not br Is Nothing Then
                                If br.Position.DistanceTo(nWCSPos) <= pPrefs.x_prec Then
                                    CLDS_FindNodeAtPosition = br
                                    Exit Function
                                End If
                            End If
                        End If
                    End If
                Catch ex As Exception

                End Try
            End If
        Next
    End Function
    Public Function CLDS_FindNode(ByVal nTrans As Transaction, _
                                  ByVal nDict As DBDictionary, _
                                  ByVal nID As String) _
                                  As ObjectId
        If String.IsNullOrEmpty(nID) Then
            CLDS_FindNode = ObjectId.Null
            Exit Function
        End If
        Dim kID As String = CLDS_Static_Utils.CLDS_Node_Key(nID, nRule)
        Try
            Dim xr As Xrecord = TryCast(nTrans.GetObject(nDict.GetAt(kID), OpenMode.ForRead), Xrecord)
            If xr Is Nothing Then
                CLDS_FindNode = ObjectId.Null
            Else
                Dim rb As ResultBuffer = xr.Data
                If rb Is Nothing Then
                    CLDS_FindNode = ObjectId.Null
                Else
                    Dim tv As TypedValue() = rb.AsArray
                    Dim hn As Handle = New Handle(tv(0).Value)
                    Dim x As ObjectId = nDict.Database.GetObjectId(False, hn, 0)
                    CLDS_FindNode = x
                End If
            End If
        Catch ex As Exception
            CLDS_FindNode = ObjectId.Null
        End Try
    End Function
    Public Sub CLDS_RemoveEntries(ByVal db As Database, ByVal nTrans As Transaction, ByVal nKeys As Collection)
        If nKeys.Count = 0 Then
            Exit Sub
        End If
        Dim noDict As DBDictionary = DirectCast(nTrans.GetObject(db.NamedObjectsDictionaryId, OpenMode.ForRead), DBDictionary)
        Dim nDict As DBDictionary
        Try
            nDict = DirectCast(nTrans.GetObject(noDict.GetAt(pPrefs.d_node), OpenMode.ForWrite), DBDictionary)
            For Each kID As String In nKeys
                Try
                    Dim xr As ObjectId = nDict.GetAt(kID)
                    If Not xr = ObjectId.Null Then
                        nDict.Remove(xr)
                    End If
                Catch exn As Exception
                End Try
            Next
        Catch exd As Exception
        End Try
    End Sub
    Public Sub CLDS_RemoveEntry(ByVal db As Database, ByVal nTrans As Transaction, ByVal nKey As String)
        If nKey = "" Then
            Exit Sub
        End If
        Dim noDict As DBDictionary = DirectCast(nTrans.GetObject(db.NamedObjectsDictionaryId, OpenMode.ForRead), DBDictionary)
        Dim nDict As DBDictionary
        Try
            nDict = DirectCast(nTrans.GetObject(noDict.GetAt(pPrefs.d_node), OpenMode.ForWrite), DBDictionary)
            Try
                Dim xr As ObjectId = nDict.GetAt(nKey)
                If Not xr = ObjectId.Null Then
                    nDict.Remove(xr)
                End If
            Catch exn As Exception
            End Try
        Catch exd As Exception
        End Try
    End Sub
    Public Function CLDS_RenameEntry(ByVal db As Database, ByVal nTrans As Transaction, ByVal k1 As String, ByVal k2 As String) As Boolean
        If k1 = "" Or k2 = "" Then
            Return True
        End If
        Dim noDict As DBDictionary = DirectCast(nTrans.GetObject(db.NamedObjectsDictionaryId, OpenMode.ForRead), DBDictionary)
        Dim nDict As DBDictionary
        Dim o1 As ObjectId = ObjectId.Null
        Dim o2 As ObjectId = ObjectId.Null
        Dim x1 As Xrecord
        Dim x2 As Xrecord
        Dim r1 As ResultBuffer
        Dim r2 As ResultBuffer
        Try
            nDict = DirectCast(nTrans.GetObject(noDict.GetAt(pPrefs.d_node), OpenMode.ForWrite), DBDictionary)
            Try
                o1 = nDict.GetAt(k1)
                If o1 = ObjectId.Null Then
                    Return True
                End If
            Catch exn As Exception
                Return True
            End Try
            Try
                o2 = nDict.GetAt(k2)
                If Not o2 = ObjectId.Null Then
                    Return False
                End If
            Catch exn As Exception
            End Try
            Try
                x1 = TryCast(nTrans.GetObject(o1, OpenMode.ForRead), Xrecord)
                r1 = x1.Data
                Dim v1 As TypedValue() = r1.AsArray
                x2 = New Xrecord()
                r2 = New ResultBuffer()
                For Each v As TypedValue In v1
                    r2.Add(New TypedValue(v.TypeCode, v.Value))
                Next
                x2.Data = r2
                nDict.UpgradeOpen()
                nDict.SetAt(k2, x2)
                nTrans.AddNewlyCreatedDBObject(x2, True)
                nDict.Remove(o1)
                Return True
            Catch ex As Exception
                Return True
            End Try
        Catch exd As Exception
            Return True
        End Try
    End Function
    Public Function CLDS_NextNode(ByVal nTrans As Transaction, _
                                  ByVal nDict As DBDictionary, _
                                  ByVal nID As String, _
                                  ByVal xRule As CLDS_Flex_Format) _
                                  As String
        If String.IsNullOrEmpty(nID) And xRule Is Nothing Then
            Return "-"
        End If
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim xID As String = nID
        Dim zID As String = xID
        Dim maxn As Integer = 9999
        Dim minn As Integer = 1
        If xRule Is Nothing Then
            Return nID
        Else
            If xRule.IndexFor("N") = 0 Then
                Dim p As String = xRule.Prompt_All(ed)
                If Mid$(p, 1, 4) = "QUIT" Then
                    Return "QUIT"
                End If
                If Mid$(p, 1, 6) = "ERROR:" Then
                    MsgBox(p, MsgBoxStyle.Critical, "CMPIC AutoCAD")
                    Return "-"
                End If
            End If
            maxn = xRule.MaxNo
            minn = xRule.StartNo
        End If
        For i As Integer = minn To maxn
            xRule.Binds(i)
            xID = xRule.Combine_All
            zID = xRule.Combine_Key
            Dim kID As String = CLDS_Static_Utils.CLDS_Node_Key(zID)
            Dim fID As String = ""
            Try
                Dim xr As Xrecord = TryCast(nTrans.GetObject(nDict.GetAt(kID), OpenMode.ForRead), Xrecord)
                If xr Is Nothing Then
                    fID = xID
                End If
            Catch ex As Exception
                fID = xID
            End Try
            If fID <> "" Then
                Dim nc(,) As String
                Dim ncc As Collection = Nothing
                Dim nr As Integer = CLDS_Query(Application.DocumentManager.MdiActiveDocument.Editor, 1, "ND", "ND", xID, nc, ncc)
                If nr < 0 Then
                    MsgBox(CMERR, MsgBoxStyle.Critical, "CMPIC AutoCAD")
                    Return "-"
                End If
                If nr = 0 Then
                    Return xID
                End If
            End If
        Next i
        Return "-"
    End Function
    Public Sub CLDS_AddNode(ByVal dTrans As Transaction, _
                            ByVal nDict As DBDictionary, _
                            ByVal nID As String, _
                            ByVal nObj As ObjectId)
        Dim kID As String = CLDS_Static_Utils.CLDS_Node_Key(nID, nRule)
        Dim x As ObjectId = CLDS_FindNode(dTrans, nDict, nID)
        Dim xrec As Xrecord
        If x.IsNull Then
            xrec = New Xrecord()
            Dim xbuf As ResultBuffer = New ResultBuffer()
            xbuf.Add(New TypedValue(DxfCode.Handle, nObj.Handle.Value))
            xrec.Data = xbuf
            nDict.UpgradeOpen()
            nDict.SetAt(kID, xrec)
            dTrans.AddNewlyCreatedDBObject(xrec, True)
        Else
            xrec = TryCast(dTrans.GetObject(nDict.GetAt(kID), OpenMode.ForWrite), Xrecord)
            Dim xbuf As ResultBuffer = New ResultBuffer()
            xbuf.Add(New TypedValue(DxfCode.Handle, nObj.Handle.Value))
            xrec.UpgradeOpen()
            xrec.Data = xbuf
        End If
    End Sub
    Public Function CLDS_FindSegment(ByVal sTrans As Transaction, _
                                     ByVal nDict As DBDictionary, _
                                     ByVal fnID As String, _
                                     ByVal tnID As String, _
                                     Optional ByVal tries As Integer = 1) _
                                     As ObjectId
        If String.IsNullOrEmpty(fnID) Or String.IsNullOrEmpty(tnID) Then
            CLDS_FindSegment = ObjectId.Null
            Exit Function
        End If
        For i As Integer = 1 To tries
            Dim sgID As String
            If i = 1 Then
                sgID = CLDS_Static_Utils.CLDS_Segment_Key(fnID, tnID)
            Else
                sgID = CLDS_Static_Utils.CLDS_Segment_Key(tnID, fnID)
            End If
            Try
                Dim xr As Xrecord = TryCast(sTrans.GetObject(nDict.GetAt(sgID), OpenMode.ForRead), Xrecord)
                If xr Is Nothing Then
                    CLDS_FindSegment = ObjectId.Null
                Else
                    Dim rb As ResultBuffer = xr.Data
                    Dim tv As TypedValue() = rb.AsArray
                    Dim hn As Handle = New Handle(tv(0).Value)
                    Dim x As ObjectId = nDict.Database.GetObjectId(False, hn, 0)
                    CLDS_FindSegment = x
                    Exit Function
                End If
            Catch ex As Exception
                CLDS_FindSegment = ObjectId.Null
            End Try
        Next
    End Function
    Public Sub CLDS_SetLineXRec(ByVal dTrans As Transaction, ByVal lineE As Line, _
                                ByVal fnID As String, _
                                ByVal tnID As String, _
                                Optional ByVal sType As String = "", _
                                Optional ByVal sSeg As String = "", _
                                Optional ByVal sLength As String = "", _
                                Optional ByVal segID As String = "", _
                                Optional ByVal rwayID As String = "")
        If lineE.ExtensionDictionary = ObjectId.Null Then
            lineE.CreateExtensionDictionary()
        End If
        Dim lDict As DBDictionary = DirectCast(dTrans.GetObject(lineE.ExtensionDictionary, OpenMode.ForWrite), DBDictionary)
        Dim lxrec As Xrecord
        Dim newxrec As Boolean = False
        If lDict.Contains(pPrefs.d_xrec) Then
            Dim obj As DBObject = dTrans.GetObject(lDict.GetAt(pPrefs.d_xrec), OpenMode.ForWrite)
            lxrec = TryCast(obj, Xrecord)
            If lxrec Is Nothing Then
                obj.Erase()
                lxrec = New Xrecord
                newxrec = True
            End If
        Else
            lxrec = New Xrecord()
            newxrec = True
        End If
        Dim lxbuf As ResultBuffer = New ResultBuffer()
        lxbuf.Add(New TypedValue(DxfCode.Text, fnID))
        lxbuf.Add(New TypedValue(DxfCode.Text, tnID))
        lxbuf.Add(New TypedValue(DxfCode.Text, sType))
        lxbuf.Add(New TypedValue(DxfCode.Text, sSeg))
        lxbuf.Add(New TypedValue(DxfCode.Text, sLength))
        lxbuf.Add(New TypedValue(DxfCode.Text, segID))
        lxbuf.Add(New TypedValue(DxfCode.Text, rwayID))
        lxrec.Data = lxbuf
        If newxrec Then
            lDict.SetAt(pPrefs.d_xrec, lxrec)
            dTrans.AddNewlyCreatedDBObject(lxrec, True)
        End If
    End Sub
    Public Sub CLDS_SetBlockXRec(ByVal dTrans As Transaction, ByVal blockE As BlockReference, _
                                ByVal nID As String, _
                                Optional ByVal sType As String = "", _
                                Optional ByVal sSeg As String = "", _
                                Optional ByVal sLength As String = "", _
                                Optional ByVal segID As String = "", _
                                Optional ByVal rwayID As String = "", _
                                Optional ByVal nMajor As String = "")
        If blockE.ExtensionDictionary = ObjectId.Null Then
            blockE.CreateExtensionDictionary()
        End If
        Dim lDict As DBDictionary = DirectCast(dTrans.GetObject(blockE.ExtensionDictionary, OpenMode.ForWrite), DBDictionary)
        Dim lxrec As Xrecord
        Dim newxrec As Boolean = False
        If lDict.Contains(pPrefs.d_xrec) Then
            Dim obj As DBObject = dTrans.GetObject(lDict.GetAt(pPrefs.d_xrec), OpenMode.ForWrite)
            lxrec = TryCast(obj, Xrecord)
            If lxrec Is Nothing Then
                obj.Erase()
                lxrec = New Xrecord
                newxrec = True
            End If
        Else
            lxrec = New Xrecord()
            newxrec = True
        End If
        Dim lxbuf As ResultBuffer = New ResultBuffer()
        lxbuf.Add(New TypedValue(DxfCode.Text, nID))        ' 0
        lxbuf.Add(New TypedValue(DxfCode.Text, nID))        ' 1
        lxbuf.Add(New TypedValue(DxfCode.Text, sType))      ' 2
        lxbuf.Add(New TypedValue(DxfCode.Text, sSeg))       ' 3
        lxbuf.Add(New TypedValue(DxfCode.Text, sLength))    ' 4
        lxbuf.Add(New TypedValue(DxfCode.Text, segID))      ' 5
        lxbuf.Add(New TypedValue(DxfCode.Text, rwayID))     ' 6
        lxbuf.Add(New TypedValue(DxfCode.Text, nMajor))     ' 7
        lxrec.Data = lxbuf
        If newxrec Then
            lDict.SetAt(pPrefs.d_xrec, lxrec)
            dTrans.AddNewlyCreatedDBObject(lxrec, True)
        End If
    End Sub
    Public Sub CLDS_AddBreakNode(ByVal dTrans As Transaction, _
                                 ByVal doc As Document, _
                                 ByVal lineE As Line, _
                                 ByVal nodeE As BlockReference)
        If lineE.ExtensionDictionary = ObjectId.Null Then
            lineE.CreateExtensionDictionary()
        End If
        Dim nID As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_node)
        Dim lDict As DBDictionary = DirectCast(dTrans.GetObject(lineE.ExtensionDictionary, OpenMode.ForWrite), DBDictionary)
        Dim rb As ResultBuffer
        Dim xr As Xrecord
        Try
            xr = TryCast(dTrans.GetObject(lDict.GetAt(pPrefs.d_brek), OpenMode.ForRead), Xrecord)
        Catch
            xr = Nothing
        End Try
        Dim j As Integer = -1
        If xr Is Nothing Then
            rb = New ResultBuffer()
        Else
            rb = xr.Data
            If rb Is Nothing Then
                rb = New ResultBuffer()
            Else
                Dim ra As TypedValue() = rb.AsArray
                For i As Integer = 0 To ra.Length - 1
                    Dim bn As String = ra(i).Value
                    If bn = nID Then
                        j = i
                        Exit For
                    End If
                Next
            End If
        End If
        Dim lxrec As Xrecord = New Xrecord()
        If j >= 0 Then
            Dim xb As New ResultBuffer()
            Dim ra As TypedValue() = rb.AsArray
            For i As Integer = 0 To ra.Length - 1
                If i <> j Then
                    xb.Add(New TypedValue(DxfCode.Text, ra(i).Value))
                End If
            Next
            lxrec.Data = xb
            CLDS_Static_Utils.CLDS_WriteMessage(Application.DocumentManager.MdiActiveDocument.Editor, "Removed break at node " & nID)
            If ra.Length > 1 Then
                CLDS_CheckLayer(dTrans, doc, pPrefs.l_brek, pPrefs.c_brek)
                CLDS_SetLayer(lineE, pPrefs.l_brek, "Segment")
                'lineE.Layer = pPrefs.l_brek
            Else
                CLDS_CheckLayer(dTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                CLDS_SetLayer(lineE, pPrefs.l_updt, "Segment")
                'lineE.Layer = pPrefs.l_updt
            End If
        Else
            rb.Add(New TypedValue(DxfCode.Text, nID))
            lxrec.Data = rb
            CLDS_Static_Utils.CLDS_WriteMessage(Application.DocumentManager.MdiActiveDocument.Editor, "Added break at node " & nID)
            CLDS_CheckLayer(dTrans, doc, pPrefs.l_brek, pPrefs.c_brek)
            CLDS_SetLayer(lineE, pPrefs.l_brek, "Segment")
            'lineE.Layer = pPrefs.l_brek
        End If
        lDict.SetAt(pPrefs.d_brek, lxrec)
        dTrans.AddNewlyCreatedDBObject(lxrec, True)
    End Sub
    Public Sub CLDS_ClearAllBreaks(ByVal dTrans As Transaction, ByVal lineE As Line)
        If lineE.ExtensionDictionary = ObjectId.Null Then
            lineE.CreateExtensionDictionary()
        End If
        Dim lDict As DBDictionary = DirectCast(dTrans.GetObject(lineE.ExtensionDictionary, OpenMode.ForWrite), DBDictionary)
        Dim xr As Xrecord
        Try
            xr = TryCast(dTrans.GetObject(lDict.GetAt(pPrefs.d_brek), OpenMode.ForRead), Xrecord)
        Catch
            xr = Nothing
        End Try
        If Not xr Is Nothing Then
            xr.Data = Nothing
            lDict.Remove(pPrefs.d_brek)
        End If
    End Sub
    Public Sub CLDS_ShowBreakNodes(ByVal dTrans As Transaction, ByVal lineE As Line, ByVal lv As ListView)
        Dim rb As ResultBuffer = CLDS_GetBreakXRecord(dTrans, lineE)
        lv.Clear()
        lv.Columns.Add("Sequence")
        lv.Columns.Add("Node")
        If Not rb Is Nothing Then
            Dim ra As TypedValue() = rb.AsArray
            For i As Integer = 0 To ra.Length - 1
                Dim lvi As New ListViewItem
                lvi.Text = Str$(i + 1)
                lvi.SubItems.Add(ra(i).Value)
                lv.Items.Add(lvi)
            Next
        End If
        For i As Integer = 0 To lv.Columns.Count - 1
            lv.Columns(i).Width = -2
        Next
        lv.Update()
    End Sub
    Public Sub CLDS_AddSegment(ByVal dTrans As Transaction, _
                                ByVal nDict As DBDictionary, _
                                ByVal fnID As String, _
                                ByVal tnID As String, _
                                ByVal sType As String, _
                                ByVal sSeg As String, _
                                ByVal sLength As String, _
                                ByVal nObj As ObjectId, _
                                ByVal segID As String, _
                                ByVal rwayID As String)
        If Not nDict Is Nothing Then
            Dim sgID As String = CLDS_Static_Utils.CLDS_Segment_Key(fnID, tnID)
            Dim x As ObjectId = CLDS_FindSegment(dTrans, nDict, fnID, tnID, 1)
            Dim xrec As Xrecord
            If x.IsNull Then
                xrec = New Xrecord()
                Dim xbuf As ResultBuffer = New ResultBuffer()
                xbuf.Add(New TypedValue(DxfCode.Handle, nObj.Handle.Value))
                xrec.Data = xbuf
                nDict.UpgradeOpen()
                nDict.SetAt(sgID, xrec)
                dTrans.AddNewlyCreatedDBObject(xrec, True)
            Else
                xrec = TryCast(dTrans.GetObject(nDict.GetAt(sgID), OpenMode.ForWrite), Xrecord)
                Dim xbuf As ResultBuffer = New ResultBuffer()
                xbuf.Add(New TypedValue(DxfCode.Handle, nObj.Handle.Value))
                xrec.UpgradeOpen()
                xrec.Data = xbuf
            End If
        End If
        Dim lineE As Line = DirectCast(dTrans.GetObject(nObj, OpenMode.ForWrite), Line)
        CLDS_SetLineXRec(dTrans, lineE, fnID, tnID, sType, sSeg, sLength, segID, rwayID)
    End Sub
    Public Function CLDS_Get_Node_Z(ByVal p_node As String) As String
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        CLDS_Get_Node_Z = ""
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim nodeID As ObjectId = CLDS_FindNode(nTrans, nd, p_node)
                If Not nodeID = ObjectId.Null Then
                    Dim nodeE As BlockReference = DirectCast(nodeID.GetObject(OpenMode.ForRead), BlockReference)
                    Dim z As String = Trim(Str$(System.Math.Round((nodeE.Position.Z / pPrefs.x_fact), 3)))
                    CLDS_Get_Node_Z = z
                End If
                nTrans.Commit()
            End Using
        End Using
    End Function
    Public Sub CLDS_Set_Node_Z(ByVal p_node As String, ByVal p_z As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim nodeID As ObjectId = CLDS_FindNode(nTrans, nd, p_node)
                If Not nodeID = ObjectId.Null Then
                    Dim nodeE As BlockReference = DirectCast(nodeID.GetObject(OpenMode.ForWrite), BlockReference)
                    Dim z As Double = p_z * pPrefs.x_fact
                    Dim p As Point3d = New Point3d(nodeE.Position.X, nodeE.Position.Y, z)
                    Dim v As Vector3d = nodeE.Position.GetVectorTo(p)
                    nodeE.TransformBy(Matrix3d.Displacement(v))
                End If
                nTrans.Commit()
            End Using
        End Using
    End Sub
#End Region
#Region "Drawing geometry"
    Public Function UCS2WCS(ByVal nTrans As Transaction, ByVal pUCS As Point3d) As Point3d
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim mUCS As Matrix3d = ed.CurrentUserCoordinateSystem
        Return pUCS.TransformBy(mUCS)
    End Function
    Public Function WCS2UCS(ByVal nTrans As Transaction, ByVal pWCS As Point3d) As Point3d
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim mWCS As Matrix3d = ed.CurrentUserCoordinateSystem.Inverse
        Return pWCS.TransformBy(mWCS)
    End Function
#End Region
#Region "Multi-colour utilities"
    Public Sub Allocate(ByVal p_trans As Transaction, _
                            ByVal p_doc As Document, _
                            ByVal p_layer As String, _
                            ByVal p_dflt As System.Drawing.Color, _
                            Optional ByVal p_pref As Integer = 0)
        Dim c As System.Drawing.Color
        Dim l As Integer = 0
        Dim i As Integer = pPrefs.c_seqn.Count
        If p_pref > i Then                              ' Insufficient colours, use default
            c = p_dflt
            If Not uColour.ContainsKey(p_pref) Then
                uColour.Add(p_pref, p_layer)
            End If
        Else
            If uColour.ContainsValue(p_layer) Then
                For Each item As System.Collections.Generic.KeyValuePair(Of Integer, String) In uColour
                    If item.Value = p_layer Then
                        l = item.Key
                    End If
                Next
            End If
            If l >= 1 Then
                c = pPrefs.c_seqn.Item(l - 1)           ' Colour already allocated
            Else
                c = p_dflt
                If p_pref > 0 Then
                    If Not uColour.ContainsKey(p_pref) Then         ' Use preferred colour
                        uColour.Add(p_pref, p_layer)
                        c = pPrefs.c_seqn.Item(p_pref - 1)
                        l = p_pref
                    End If
                End If
                If l = 0 Then
                    For j As Integer = 1 To i               ' Look for first unallocated colour
                        If Not uColour.ContainsKey(j) Then
                            uColour.Add(j, p_layer)
                            c = pPrefs.c_seqn.Item(j - 1)
                            Exit For
                        End If
                    Next
                End If
            End If
        End If
        CLDS_CheckLayer(p_trans, p_doc, p_layer, c, False)
    End Sub
    Public Sub Deallocate(ByVal p_layer As String)
        Dim l As Integer = 0
        If uColour.ContainsValue(p_layer) Then
            For Each item As System.Collections.Generic.KeyValuePair(Of Integer, String) In uColour
                If item.Value = p_layer Then
                    l = item.Key
                End If
            Next
        End If
        If l > 0 Then
            uColour.Remove(l)
        End If
    End Sub
    Public Sub DeallocateAll()
        If uColour.Count > 0 Then
            Dim doc As Document
            Dim ed As Editor
            doc = Application.DocumentManager.MdiActiveDocument
            ed = doc.Editor
            Using acLckDoc As DocumentLock = doc.LockDocument()
                Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                    For Each item As System.Collections.Generic.KeyValuePair(Of Integer, String) In uColour
                        CLDS_DeleteLayer(nTrans, doc, item.Value)
                    Next
                    nTrans.Commit()
                End Using
            End Using
        End If
        uColour = Nothing
        uColour = New System.Collections.Generic.Dictionary(Of Integer, String)
    End Sub
#End Region
#Region "Network edit"
    Public Sub CLDS_SetOrigin(ByVal nTrans As Transaction)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim psr As PromptSelectionResult = CLDS_SelectOrigin(ed)
        Dim oid As ObjectId
        Dim obr As BlockReference
        Dim pbr As Point3d
        X_CMPIC = 0
        Y_CMPIC = 0
        X_LOCAL = 0
        Y_LOCAL = 0
        A_LOCAL = 0
        If psr.Status = PromptStatus.OK Then
            Dim sobj() As ObjectId = psr.Value.GetObjectIds
            If sobj.GetLength(0) = 1 Then
                oid = sobj(0)
                obr = DirectCast(oid.GetObject(OpenMode.ForRead), BlockReference)
                Dim xS As String = CLDS_GetBlockAttr(obr, "X")
                Dim yS As String = CLDS_GetBlockAttr(obr, "Y")
                Dim rS As String = CLDS_GetBlockAttr(obr, "ROTATION")
                X_CMPIC = Val(xS)
                Y_CMPIC = Val(yS)
                'pbr = UCS2WCS(nTrans, obr.Position)
                pbr = obr.Position
                X_LOCAL = pbr.X
                Y_LOCAL = pbr.Y
                A_LOCAL = Val(rS)
            Else
                ed.WriteMessage(vbCrLf & "Too many " & pPrefs.b_orgn & " blocks in drawing")
            End If
            Dim nobj() As ObjectId
            ed.SetImpliedSelection(nobj)
        End If

    End Sub
    Public Sub CLDS_DisplaySegment(Optional ByVal p_n1 As String = "", Optional ByVal p_n2 As String = "", Optional ByVal p_zoom As Boolean = False)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim slObj As ObjectId
                If p_n1 = "" Or p_n2 = "" Then
                    Dim peo As New PromptEntityOptions(vbLf & "Select segment line:")
                    peo.SetRejectMessage("Line selection required." & vbCrLf)
                    peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Line), False)
                    Dim per As PromptEntityResult = ed.GetEntity(peo)
                    If per.Status = PromptStatus.OK Then
                        slObj = per.ObjectId
                    Else
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                        Exit Sub
                    End If
                Else
                    slObj = CLDS_FindSegment(nTrans, nd, p_n1, p_n2)
                    If slObj.IsNull Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment not found")
                        Exit Sub
                    End If
                End If
                Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                If rb Is Nothing Then
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "No CMPIC segment attributes found")
                    Exit Sub
                End If
                Dim ra As TypedValue() = rb.AsArray
                ed.WriteMessage(vbCrLf & "From:   " & ra(0).Value)
                ed.WriteMessage(vbCrLf & "To:     " & ra(1).Value)
                If ra.Length > 2 Then
                    ed.WriteMessage(vbCrLf & "Type:   " & ra(2).Value)
                End If
                If ra.Length > 3 Then
                    ed.WriteMessage(vbCrLf & "Seg:    " & ra(3).Value)
                End If
                If ra.Length > 4 Then
                    ed.WriteMessage(vbCrLf & "Length: " & ra(4).Value)
                End If
                If p_zoom Then
                    Dim ext As Extents3d
                    Dim ent As Entity = DirectCast(nTrans.GetObject(slObj, OpenMode.ForRead), Entity)
                    ext = ent.GeometricExtents
                    ext.TransformBy(ed.CurrentUserCoordinateSystem.Inverse)

                    Dim cp As Point3d = New Point3d((ext.MinPoint.X + ext.MaxPoint.X) / 2.0, _
                                                   (ext.MinPoint.Y + ext.MaxPoint.Y) / 2.0, _
                                                   (ext.MinPoint.Z + ext.MaxPoint.Z) / 2.0)
                    CLDS_Static_Utils.ZoomWin4(ed, cp)
                End If
                nTrans.Commit()
            End Using
        End Using
        ed.WriteMessage(vbCrLf & "Command: ")
    End Sub
    Public Function CLDS_GetSegmentProps(ByVal slObj As ObjectId) As CLDS_Segment_Properties
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        CLDS_GetSegmentProps = Nothing
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                If UCase(slObj.ObjectClass.Name) = "ACDBLINE" Then
                    Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                    Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                    If rb Is Nothing Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "No CMPIC segment attributes found")
                    Else
                        Dim sp As New CLDS_Segment_Properties
                        Dim ra As TypedValue() = rb.AsArray
                        sp.Tag = "SEG"
                        sp.FNode = ra(0).Value
                        sp.TNode = ra(1).Value
                        sp.Area = "-"
                        If ra.Length > 2 Then
                            sp.Type = ra(2).Value
                            If sp.Type = pPrefs.n_jump Then
                                sp.Tag = "JUMP"
                            ElseIf sp.Type = pPrefs.n_offr Then
                                sp.Tag = "OFFROUTE"
                            End If
                        End If
                        If ra.Length > 3 Then
                            sp.Segregation = ra(3).Value
                        End If
                        If ra.Length > 4 Then
                            sp.Length = Val(ra(4).Value)
                        End If
                        If ra.Length > 5 Then
                            sp.ID = ra(5).Value
                        End If
                        If ra.Length > 6 Then
                            sp.Raceway = ra(6).Value
                        End If
                        Dim z1 As String = CLDS_Get_Node_Z(sp.FNode)
                        Dim z2 As String = CLDS_Get_Node_Z(sp.TNode)
                        If z1 = z2 Then
                            sp.Elevation = z1
                        Else
                            sp.Elevation = z1 & "," & z2
                        End If
                        sp.Major = "-"
                        sp.Obj = slObj
                        CLDS_GetSegmentProps = sp
                    End If
                ElseIf UCase(slObj.ObjectClass.Name) = "ACDBBLOCKREFERENCE" Then
                    Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                    Dim z As String = Trim(Str$(System.Math.Round((nodeB.Position.Z / pPrefs.x_fact), 3)))
                    Dim np As New CLDS_Segment_Properties
                    If nodeB.Name = pPrefs.b_node Or nodeB.Name = pPrefs.b_nodm Then
                        np.ID = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
                        np.FNode = "-"
                        np.TNode = "-"
                        np.Area = CLDS_GetBlockAttr(nodeB, pPrefs.t_area)
                        np.Comment = CLDS_GetBlockAttr(nodeB, pPrefs.t_comm)
                        np.Type = CLDS_GetBlockAttr(nodeB, pPrefs.t_type)
                        np.Segregation = CLDS_GetBlockAttr(nodeB, pPrefs.t_seg)
                        np.Length = pPrefs.x_psln
                        np.Raceway = "-"
                        np.Elevation = Trim(Str$(z))
                        If nodeB.Name = pPrefs.b_nodm Then
                            np.Major = "Y"
                        Else
                            np.Major = "N"
                        End If
                        Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, nodeB)
                        If np.Type = "" Then
                            np.Tag = "NODE"
                            np.Length = 0
                            If Not rb Is Nothing Then
                                Dim ra As TypedValue() = rb.AsArray
                                If ra.Length > 7 Then
                                    np.Major = ra(7).Value
                                End If
                            End If
                        Else
                            np.Tag = "PS"
                            np.FNode = np.ID
                            np.TNode = np.FNode
                            If rb Is Nothing Then
                                np.ID = "-"
                                np.Length = pPrefs.x_psln
                            Else
                                Dim ra As TypedValue() = rb.AsArray
                                If ra.Length > 4 Then
                                    np.Length = Val(ra(4).Value)
                                End If
                                If ra.Length > 5 Then
                                    np.ID = ra(5).Value
                                End If
                                If ra.Length > 6 Then
                                    np.Raceway = ra(6).Value
                                End If
                                If ra.Length > 7 Then
                                    np.Major = ra(7).Value
                                End If
                            End If
                        End If
                    ElseIf nodeB.Name = pPrefs.b_dvce Then
                        np.ID = CLDS_GetBlockAttr(nodeB, pPrefs.t_dvce)
                        np.FNode = "-"
                        np.TNode = "-"
                        np.Area = CLDS_GetBlockAttr(nodeB, pPrefs.t_area)
                        np.Comment = CLDS_GetBlockAttr(nodeB, pPrefs.t_comm)
                        np.Type = "-"
                        np.Segregation = "-"
                        np.Length = 0
                        np.Tag = "DEVICE"
                        np.Raceway = "-"
                        np.Elevation = Trim(Str$(z))
                        np.Major = "-"
                    Else
                        np = Nothing
                    End If
                    np.Obj = slObj
                    CLDS_GetSegmentProps = np
                End If
                nTrans.Commit()
            End Using
        End Using
    End Function
    Public Sub CLDS_ShowNetworkProperties(ByVal p_dialog As CLDS_Network_Container)
        Dim slObj As ObjectId = CLDS_PickSegmentObject()
        If Not slObj.IsNull Then
            If Not p_dialog.Props Is Nothing Then
                p_dialog.Props = Nothing
            End If
            Dim slProps As CLDS_Segment_Properties = CLDS_GetSegmentProps(slObj)
            slProps.SetAttributes()
            p_dialog.VObject = slObj
            p_dialog.Changed = False
            p_dialog.Props = slProps
            p_dialog.pgNProps.SelectedObject = slProps
            p_dialog.pgNProps.Update()
            p_dialog.btUClear.Enabled = False
            p_dialog.btUSave.Enabled = False
        End If
    End Sub
    Public Sub CLDS_SetNetworkProperties(ByVal p_dialog As CLDS_Network_Container)
        Dim m As CLDS_Segment_Properties
        If a_net.Count = 0 Then
            p_dialog.VObject = Nothing
            m = Nothing
        Else
            m = New CLDS_Segment_Properties
            For i As Integer = 0 To a_net.Count - 1
                Dim s As CLDS_Segment_Properties = DirectCast(a_net(i), CLDS_Segment_Properties)
                If i = 0 Then
                    m.Tag = s.Tag
                    m.FNode = s.FNode
                    m.TNode = s.TNode
                    m.ID = s.ID
                    m.Length = s.Length
                    m.Raceway = s.Raceway
                    m.Segregation = s.Segregation
                    m.Area = s.Area
                    m.Type = s.Type
                    m.Elevation = s.Elevation
                    m.Major = s.Major
                    m.Comment = s.Comment
                    If ((m.Tag = "SEG" Or m.Tag = "PS") And p_dialog.MTCounts.Contains(m.Type)) Then
                        m.MTCount = p_dialog.MTCounts(m.Type)
                    Else
                        m.MTCount = 0
                    End If
                    p_dialog.VObject = s.Obj
                Else
                    If s.Tag <> m.Tag Then
                        m.Tag = v_varies
                    End If
                    If s.FNode <> m.FNode Then
                        m.FNode = v_varies
                    End If
                    If s.TNode <> m.TNode Then
                        m.TNode = v_varies
                    End If
                    If s.ID <> m.ID Then
                        m.ID = v_varies
                    End If
                    If s.Length <> m.Length Then
                        m.Length = -1
                    End If
                    If s.Raceway <> m.Raceway Then
                        m.Raceway = v_varies
                    End If
                    If s.Elevation <> m.Elevation Then
                        m.Elevation = v_varies
                    End If
                    If s.Segregation <> m.Segregation Then
                        m.Segregation = v_varies
                    End If
                    If s.Area <> m.Area Then
                        m.Area = v_varies
                    End If
                    If s.Major <> m.Major Then
                        m.Major = v_varies
                    End If
                    If s.Comment <> m.Comment Then
                        m.Comment = v_varies
                    End If
                    If s.Type <> m.Type Then
                        m.Type = v_varies
                        m.MTCount = 0
                    End If
                    p_dialog.VObject = Nothing
                End If
            Next
        End If
        p_dialog.Props = m
        If Not m Is Nothing Then
            m.SetAttributes()
        End If
        p_dialog.Changed = False
        p_dialog.MTProps = Nothing
        p_dialog.MTChanged = False
        p_dialog.pgNProps.SelectedObject = p_dialog.Props
        p_dialog.pgNProps.Update()
        p_dialog.btUClear.Enabled = False
        p_dialog.btUSave.Enabled = False
        If a_net.Count > 0 Then
            p_dialog.btDelete.Enabled = True
        Else
            p_dialog.btDelete.Enabled = False
        End If
    End Sub
    Public Sub CLDS_ShowMultiNetworkProperties(ByVal p_dialog As CLDS_Network_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If Not p_dialog.Props Is Nothing Then
            p_dialog.Props = Nothing
        End If
        If Not p_dialog.MTProps Is Nothing Then
            p_dialog.MTProps = Nothing
        End If
        If Not p_dialog.pgNProps.SelectedObject Is Nothing Then
            p_dialog.pgNProps.SelectedObject = Nothing
        End If
        p_dialog.btMTiers.Enabled = False
        a_net = New ArrayList
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) > 0 Then
                    For i As Integer = 0 To sobj.GetLength(0) - 1
                        Dim s As CLDS_Segment_Properties = CLDS_GetSegmentProps(sobj(i))
                        If Not s Is Nothing Then
                            If ((s.Tag = "SEG" Or s.Tag = "PS")) And p_dialog.MTCounts.Contains(s.Type) Then
                                s.MTCount = p_dialog.MTCounts(s.Type)
                            Else
                                s.MTCount = 0
                            End If
                            a_net.Add(s)
                        End If
                    Next
                End If
                'Dim nobj() As ObjectId
                'ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        CLDS_Static_Utils.CLDS_WriteMessage(ed, a_net.Count & " entities selected")
        CLDS_SetNetworkProperties(p_dialog)
        If p_dialog.Props Is Nothing Then
            p_dialog.btMTiers.Enabled = False
            p_dialog.btCopy.Enabled = False
            p_dialog.btPaste.Enabled = False
        Else
            If p_dialog.Props.MTCount > 0 Then
                p_dialog.btMTiers.Enabled = True
            Else
                p_dialog.btMTiers.Enabled = False
            End If
            p_dialog.btCopy.Enabled = True
            p_dialog.btPaste.Enabled = True
        End If
    End Sub
    Public Sub CLDS_ShowMTProperties(ByVal p_dialog As CLDS_Network_Container)
        Dim doc As Document
        Dim ed As Editor
        Dim mt As New CLDS_MTSegment_Properties
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer
        Dim id As String
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        mt.MTCode = p_dialog.Props.Type
        mt.MTCount = p_dialog.Props.MTCount
        id = "MTTYPE=""" & mt.MTCode & """ MTSEG=""" & p_dialog.Props.Segregation & """ MTCOUNT=""" & Trim(Str$(mt.MTCount)) & """"
        nr = CLDS_Query(ed, 1, "MT", "MT", id, sc, scc, 0)
        If nr <= 0 Then
            p_dialog.MTProps = Nothing
            Exit Sub
        End If
        mt.MTTiers = sc(scc("MT_TIERID"), 1)
        mt.MTTypes = sc(scc("MT_NRTYPE"), 1)
        mt.MTYOffs = sc(scc("MT_YOFFSET"), 1)
        mt.MTZOffs = sc(scc("MT_ZOFFSET"), 1)
        mt.MTSegs = sc(scc("MT_SEGREGATION"), 1)
        p_dialog.MTProps = mt
        p_dialog.MTChanged = False
    End Sub
    Public Function CLDS_SaveMTProperties(ByVal p_dialog As CLDS_Network_Container) As Boolean
        Dim doc As Document
        Dim ed As Editor
        Dim mt As CLDS_MTSegment_Properties = p_dialog.MTProps
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer
        Dim id As String
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        id = "MTCOUNT=""" & Trim(Str$(mt.MTCount)) & """"
        id = id & " MTCODE=""" & mt.MTCode & """"
        id = id & " SGCODE=""" & p_dialog.Props.Segregation & """"
        If mt.MTTiers <> "" Then
            id = id & " MTTIERS=""" & mt.MTTiers & """"
        End If
        If mt.MTTypes <> "" Then
            id = id & " MTTYPES=""" & mt.MTTypes & """"
        End If
        'If mt.MTYOffs <> "" Then
        'id = id & " MTYOFFS=""" & mt.MTYOffs & """"
        'End If
        If mt.MTZOffs <> "" Then
            id = id & " MTZOFFS=""" & mt.MTZOffs & """"
        End If
        If mt.MTSegs <> "" Then
            id = id & " MTSEGS=""" & mt.MTSegs & """"
        End If
        nr = CLDS_Query(ed, 1, "UPDATE", "MT", id, sc, scc, 0)
        If nr <= 0 Then
            MsgBox(CMERR, MsgBoxStyle.Critical, "CMPIC Multi-tier Update")
            Return False
        End If
        Dim nrt As String = sc(scc("MT_NRTYPE"), 1)
        Dim seg As String = sc(scc("MT_SGCODE"), 1)
        If nrt <> p_dialog.Props.Type Then
            p_dialog.Props.Type = nrt
            p_dialog.Changed = True
            If p_dialog.Props.Tag = "SEG" Then
                If Not p_dialog.cbDType.Items.Contains(nrt) Then
                    p_dialog.cbDType.Items.Add(nrt)
                End If
                If Not CLDS_Type_Prop_Converter.TypeList.Contains(nrt) Then
                    CLDS_Type_Prop_Converter.TypeList.Add(nrt)
                End If
            ElseIf p_dialog.Props.Tag = "PS" Then
                If Not p_dialog.cbDPSType.Items.Contains(nrt) Then
                    p_dialog.cbDPSType.Items.Add(nrt)
                End If
                If Not CLDS_Type_Prop_Converter.PSList.Contains(nrt) Then
                    CLDS_Type_Prop_Converter.PSList.Add(nrt)
                End If
            End If
        End If
        If seg <> p_dialog.Props.Segregation Then
            p_dialog.Props.Segregation = seg
            p_dialog.Changed = True
            If Not p_dialog.cbDSeg.Items.Contains(seg) Then
                p_dialog.cbDSeg.Items.Add(seg)
            End If
            If Not CLDS_Seg_Prop_Converter.SegList.Contains(seg) Then
                CLDS_Seg_Prop_Converter.SegList.Add(seg)
            End If
        End If
        Return True
    End Function
    Public Sub CLDS_MakeNetworkDefaults(ByVal p_dialog As CLDS_Network_Container)
        If p_dialog.Props Is Nothing Then
            Exit Sub
        End If
        If p_dialog.Props.Tag = "SEG" Then
            If p_dialog.Props.Type <> v_varies Then
                p_dialog.cbDType.Text = p_dialog.Props.Type
            End If
            If p_dialog.Props.Raceway <> v_varies Then
                p_dialog.tbDRWay.Text = p_dialog.Props.Raceway
            End If
            If p_dialog.Props.Segregation <> v_varies Then
                p_dialog.cbDSeg.Text = p_dialog.Props.Segregation
            End If
        ElseIf p_dialog.Props.Tag = "JUMP" Then
            If p_dialog.Props.Type <> v_varies Then
                p_dialog.cbDType.Text = p_dialog.Props.Type
            End If
            If p_dialog.Props.Raceway <> v_varies Then
                p_dialog.tbDRWay.Text = p_dialog.Props.Raceway
            End If
        ElseIf p_dialog.Props.Tag = "PS" Then
            If p_dialog.Props.Type <> v_varies Then
                p_dialog.cbDPSType.Text = p_dialog.Props.Type
            End If
            If p_dialog.Props.Area <> v_varies Then
                p_dialog.cbDArea.Text = p_dialog.Props.Area
            End If
            If p_dialog.Props.Raceway <> v_varies Then
                p_dialog.tbDRWay.Text = p_dialog.Props.Raceway
            End If
            If p_dialog.Props.Segregation <> v_varies Then
                p_dialog.cbDSeg.Text = p_dialog.Props.Segregation
            End If
        ElseIf p_dialog.Props.Tag = "NODE" Or p_dialog.Props.Tag = "DEVICE" Then
            If p_dialog.Props.Area <> v_varies Then
                p_dialog.cbDArea.Text = p_dialog.Props.Area
            End If
        End If
        If (p_dialog.Props.ID <> v_varies And (p_dialog.Props.Tag = "NODE" Or p_dialog.Props.Tag = "PS" Or p_dialog.Props.Tag = "DEVICE")) Then
            p_dialog.tbDZ.Text = CLDS_Get_Node_Z(p_dialog.Props.ID)
        End If
    End Sub
    Public Sub CLDS_PasteNetworkDefaults(ByVal p_dialog As CLDS_Network_Container)
        If p_dialog.Props Is Nothing Then
            Exit Sub
        End If
        Dim changed As Boolean = False
        If p_dialog.Props.Tag = "SEG" Then
            If p_dialog.cbDType.Text <> "" And p_dialog.cbDType.Text <> p_dialog.Props.Type Then
                p_dialog.Props.Type = p_dialog.cbDType.Text
                changed = True
            End If
            If p_dialog.tbDRWay.Text <> "" And p_dialog.tbDRWay.Text <> p_dialog.Props.Raceway Then
                p_dialog.Props.Raceway = p_dialog.tbDRWay.Text
                changed = True
            End If
            If p_dialog.cbDSeg.Text <> "" And p_dialog.cbDSeg.Text <> p_dialog.Props.Segregation Then
                p_dialog.Props.Segregation = p_dialog.cbDSeg.Text
                changed = True
            End If
        ElseIf p_dialog.Props.Tag = "JUMP" Then
            If p_dialog.cbDType.Text <> "" And p_dialog.cbDType.Text <> p_dialog.Props.Type Then
                p_dialog.Props.Type = p_dialog.cbDType.Text
                changed = True
            End If
            If p_dialog.tbDRWay.Text <> "" And p_dialog.tbDRWay.Text <> p_dialog.Props.Raceway Then
                p_dialog.Props.Raceway = p_dialog.tbDRWay.Text
                changed = True
            End If
        ElseIf p_dialog.Props.Tag = "PS" Then
            If p_dialog.cbDPSType.Text <> "" And p_dialog.cbDPSType.Text <> p_dialog.Props.Type Then
                p_dialog.Props.Type = p_dialog.cbDPSType.Text
                changed = True
            End If
            If p_dialog.cbDArea.Text <> "" And p_dialog.cbDArea.Text <> p_dialog.Props.Area Then
                p_dialog.Props.Area = p_dialog.cbDArea.Text
                changed = True
            End If
            If p_dialog.tbDRWay.Text <> "" And p_dialog.tbDRWay.Text <> p_dialog.Props.Raceway Then
                p_dialog.Props.Raceway = p_dialog.tbDRWay.Text
                changed = True
            End If
            If p_dialog.cbDSeg.Text <> "" And p_dialog.cbDSeg.Text <> p_dialog.Props.Segregation Then
                p_dialog.Props.Segregation = p_dialog.cbDSeg.Text
                changed = True
            End If
        ElseIf p_dialog.Props.Tag = "NODE" Or p_dialog.Props.Tag = "DEVICE" Then
            If p_dialog.cbDArea.Text <> "" And p_dialog.cbDArea.Text <> p_dialog.Props.Area Then
                p_dialog.Props.Area = p_dialog.cbDArea.Text
                changed = True
            End If
        End If
        If changed Then
            p_dialog.pgNProps.Refresh()
            p_dialog.pgNProps.Validate()
            p_dialog.pgNProps.Update()
            p_dialog.MarkChanged()
        End If
    End Sub
    Public Sub CLDS_UpdateSegmentProps(ByVal p_obj As ObjectId, ByVal p_props As CLDS_Segment_Properties)
        If p_props Is Nothing Then
            Exit Sub
        End If
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using xtrans As Transaction = doc.TransactionManager.StartTransaction
                If UCase(p_obj.ObjectClass.Name) = "ACDBLINE" Then
                    Dim lineE As Line = DirectCast(xtrans.GetObject(p_obj, OpenMode.ForWrite), Line)
                    CLDS_SetLineXRec(xtrans, lineE, p_props.FNode, p_props.TNode, p_props.Type, p_props.Segregation, p_props.Length, p_props.ID, p_props.Raceway)
                    If lineE.Layer <> pPrefs.l_isrt Then
                        CLDS_CheckLayer(xtrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                        CLDS_SetLayer(lineE, pPrefs.l_updt, "Segment")
                        'lineE.Layer = pPrefs.l_updt
                    End If
                Else
                    Dim nodeB As BlockReference = DirectCast(xtrans.GetObject(p_obj, OpenMode.ForWrite), BlockReference)
                    CLDS_SetBlockAttr(nodeB, pPrefs.t_area, p_props.Area)
                    CLDS_SetBlockAttr(nodeB, pPrefs.t_comm, p_props.Comment)
                    If p_props.Type <> "" And p_props.Type <> "-" Then
                        CLDS_SetBlockAttr(nodeB, pPrefs.t_type, p_props.Type)
                        CLDS_SetBlockAttr(nodeB, pPrefs.t_seg, p_props.Segregation)
                    End If
                    CLDS_SetBlockXRec(xtrans, nodeB, p_props.FNode, p_props.Type, p_props.Segregation, p_props.Length, p_props.ID, p_props.Raceway, p_props.Major)
                    If nodeB.Layer <> pPrefs.l_isrt Then
                        CLDS_CheckLayer(xtrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                        CLDS_SetLayer(nodeB, pPrefs.l_updt, "Node")
                        'nodeB.Layer = pPrefs.l_updt
                    End If
                End If
                xtrans.Commit()
            End Using
        End Using
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_UpdateMultiSegmentProps(ByVal p_props As CLDS_Segment_Properties)
        If p_props Is Nothing Then
            Exit Sub
        End If
        If a_net.Count = 0 Then
            Exit Sub
        End If
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using xtrans As Transaction = doc.TransactionManager.StartTransaction
                For i As Integer = 0 To a_net.Count - 1
                    Dim s As CLDS_Segment_Properties = DirectCast(a_net.Item(i), CLDS_Segment_Properties)
                    Dim sObj As ObjectId = s.Obj
                    Dim nType As String, nSeg As String, nRWay As String, nID As String, nMajor As String, nLength As Double
                    If UCase(sObj.ObjectClass.Name) = "ACDBLINE" Then
                        Dim lineE As Line = DirectCast(xtrans.GetObject(sObj, OpenMode.ForWrite), Line)
                        If p_props.Type = v_varies Then
                            nID = s.ID
                        Else
                            If p_props.ID <> "" And Left$(p_props.ID, 1) = "-" Then
                                nID = p_props.ID
                            Else
                                nID = s.ID
                            End If
                        End If
                        If p_props.Type = v_varies Then
                            nType = s.Type
                        Else
                            nType = p_props.Type
                        End If
                        If p_props.Length <= 0 Then
                            nLength = s.Length
                        Else
                            nLength = p_props.Length
                        End If
                        If p_props.Segregation = v_varies Then
                            nSeg = s.Segregation
                        Else
                            nSeg = p_props.Segregation
                        End If
                        If p_props.Raceway = v_varies Then
                            nRWay = s.Raceway
                        Else
                            nRWay = p_props.Raceway
                        End If
                        CLDS_SetLineXRec(xtrans, lineE, s.FNode, s.TNode, nType, nSeg, nLength, nID, nRWay)
                        If lineE.Layer <> pPrefs.l_isrt Then
                            CLDS_CheckLayer(xtrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                            CLDS_SetLayer(lineE, pPrefs.l_updt, "Segment " & s.FNode & ":" & s.TNode)
                            'lineE.Layer = pPrefs.l_updt
                        End If
                    Else
                        Dim nodeB As BlockReference = DirectCast(xtrans.GetObject(sObj, OpenMode.ForWrite), BlockReference)
                        If p_props.Area <> v_varies Then
                            CLDS_SetBlockAttr(nodeB, pPrefs.t_area, p_props.Area)
                        End If
                        If p_props.Comment <> v_varies Then
                            CLDS_SetBlockAttr(nodeB, pPrefs.t_comm, p_props.Comment)
                        End If
                        If p_props.Type <> "" And p_props.Type <> "-" Then
                            If p_props.Type = v_varies Then
                                nType = s.Type
                            Else
                                CLDS_SetBlockAttr(nodeB, pPrefs.t_type, p_props.Type)
                                nType = p_props.Type
                            End If
                            If p_props.Type = v_varies Then
                                nID = s.ID
                            Else
                                If p_props.ID <> "" And Left$(p_props.ID, 1) = "-" Then
                                    nID = p_props.ID
                                Else
                                    nID = s.ID
                                End If
                            End If
                            If p_props.Segregation = v_varies Then
                                nSeg = s.Segregation
                            Else
                                CLDS_SetBlockAttr(nodeB, pPrefs.t_seg, p_props.Segregation)
                                nSeg = p_props.Segregation
                            End If
                            If p_props.Raceway = v_varies Then
                                nRWay = s.Raceway
                            Else
                                nRWay = p_props.Raceway
                            End If
                            If p_props.Major = v_varies Then
                                nMajor = s.Major
                            Else
                                nMajor = p_props.Major
                            End If
                            CLDS_SetBlockXRec(xtrans, nodeB, s.FNode, nType, nSeg, s.Length, nID, nRWay, nMajor)
                            If p_props.Elevation <> v_varies Then
                                Dim p As Point3d = New Point3d(nodeB.Position.X, nodeB.Position.Y, Val(p_props.Elevation) * pPrefs.x_fact)
                                Dim v As Vector3d = nodeB.Position.GetVectorTo(p)
                                'nodeB.Position = p
                                nodeB.TransformBy(Matrix3d.Displacement(v))
                            End If
                        Else
                            If p_props.Major = v_varies Then
                                nMajor = s.Major
                            Else
                                nMajor = p_props.Major
                            End If
                            CLDS_SetBlockXRec(xtrans, nodeB, s.FNode, "", "", "", "", "", nMajor)
                        End If
                        If nodeB.Layer <> pPrefs.l_isrt Then
                            CLDS_CheckLayer(xtrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                            CLDS_SetLayer(nodeB, pPrefs.l_updt, "Node " & s.FNode)
                            'nodeB.Layer = pPrefs.l_updt
                        End If
                    End If
                Next
                xtrans.Commit()
            End Using
        End Using
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_CreateNode(ByVal p_dialog As CLDS_Network_Container, ByVal p_context As String, ByVal p_ps As Boolean, ByVal p_dev As Boolean, Optional ByVal p_id As String = "")
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_dialog.cbDArea.Text = "" Then
            MsgBox("Please ensure default area set first", MsgBoxStyle.Exclamation, "CMPIC Add node/point-segment")
            Exit Sub
        End If
        If p_dialog.rbAddPS.Checked Then
            If p_dialog.cbDPSType.Text = "" Or p_dialog.cbDSeg.Text = "" Then
                MsgBox("Please ensure default type and segregation set first", MsgBoxStyle.Exclamation, "CMPIC Add point-segment")
                Exit Sub
            End If
        End If
        Dim adding As Boolean = True
        CancelPrior()
        Dim iRule As CLDS_Flex_Format = Nothing
        If p_dev Then
            iRule = dRule
        ElseIf p_ps Then
            iRule = pRule
        Else
            iRule = nRule
        End If
        If Not (iRule Is Nothing) Then
            iRule.Bind("A") = pNetDialog.cbDArea.Text
            iRule.Bind("P") = pNetDialog.cbDPSType.Text
            iRule.Bind("R") = pNetDialog.tbDRWay.Text
            iRule.Bind("S") = pNetDialog.cbDSeg.Text
            iRule.Bind("T") = pNetDialog.cbDType.Text
            If iRule.IndexFor("N") > 0 Then
                Dim p As String = iRule.Prompt_All(ed)
                If Mid$(p, 1, 4) = "QUIT" Then
                    Exit Sub
                End If
                If Mid$(p, 1, 6) = "ERROR:" Then
                    MsgBox(p, MsgBoxStyle.Critical, "CMPIC AutoCAD")
                    Exit Sub
                End If
            End If
        End If
        While adding
            Using acLckDoc As DocumentLock = doc.LockDocument()
                Using xtrans As Transaction = doc.TransactionManager.StartTransaction
                    Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, xtrans, False)
                    Dim bt As BlockTable = DirectCast(xtrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                    Dim btr As BlockTableRecord = DirectCast(xtrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                    Dim nBlock As ObjectId
                    Dim npo As PromptPointOptions
                    Dim t_id As String, e_mssg As String
                    Dim nid As String = p_id
                    If p_dev Then
                        If iRule Is Nothing Then
                            Dim pso As PromptStringOptions = New PromptStringOptions(vbLf & "Enter unique device ID: ")
                            pso.AllowSpaces = True
                            Dim psr As PromptResult = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.GetString(pso)
                            If psr.Status = PromptStatus.OK Then
                                If psr.StringResult = "" Then
                                    adding = False
                                End If
                                nid = Trim(UCase(psr.StringResult))
                            Else
                                adding = False
                            End If
                        Else
                            nid = "*"
                        End If
                    Else
                        nid = CLDS_NextNode(xtrans, nd, nid, iRule)
                        If nid = "QUIT" Then
                            adding = False
                        ElseIf nid = "-" Then
                            If p_ps Then
                                MsgBox("ERROR: unable to generate next point-segment ID", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                            Else
                                MsgBox("ERROR: unable to generate next node ID", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                            End If
                            adding = False
                        End If
                    End If
                    If adding Then
                        Dim pointing As Boolean = True
                        If p_dev Then
                            nBlock = CLDS_FindBlock(bt, doc, pPrefs.b_dvce)
                            If nBlock.IsNull Then
                                CLDS_Static_Utils.CLDS_WriteMessage(ed, "ERROR: Unable to locate device block " & pPrefs.b_dvce & " for insertion")
                                Exit Sub
                            End If
                            t_id = pPrefs.t_dvce
                            e_mssg = "device"
                        Else
                            If p_dialog.cbIsMajor.Checked Then
                                nBlock = CLDS_FindBlock(bt, doc, pPrefs.b_nodm)
                                If nBlock.IsNull Then
                                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "ERROR: Unable to locate major node block " & pPrefs.b_nodm & " for insertion")
                                    Exit Sub
                                End If
                            Else
                                nBlock = CLDS_FindBlock(bt, doc, pPrefs.b_node)
                                If nBlock.IsNull Then
                                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "ERROR: Unable to locate node block " & pPrefs.b_node & " for insertion")
                                    Exit Sub
                                End If
                            End If
                            t_id = pPrefs.t_node
                            If p_ps Then
                                e_mssg = "point-segment"
                            Else
                                e_mssg = "node"
                            End If
                        End If
                        npo = New PromptPointOptions(vbCrLf & "Select " & e_mssg & " " & nid & " insertion point")
                        CLDS_CheckLayer(xtrans, doc, pPrefs.l_isrt, pPrefs.c_isrt)
                        While pointing
                            Dim npr As PromptPointResult = ed.GetPoint(npo) ' Prompt point result is UCS
                            If npr.Status = PromptStatus.OK Then
                                Dim np As Point3d = npr.Value
                                Dim xp As Point3d = np
                                If p_dialog.tbDZ.Text <> "" Then
                                    xp = New Point3d(np.X, np.Y, Val(p_dialog.tbDZ.Text) * pPrefs.x_fact)
                                    np = xp
                                End If
                                np = UCS2WCS(xtrans, xp) ' Required node insertion point is WCS
                                Dim xn As BlockReference = CLDS_FindNodeAtPosition(xtrans, nd, np)
                                If Not xn Is Nothing Then
                                    Dim xid As String = CLDS_GetBlockAttr(xn, t_id)
                                    Dim xty As String = CLDS_GetBlockAttr(xn, pPrefs.t_type)
                                    If p_ps Then
                                        If xty = "" Then
                                            CLDS_SetBlockAttr(xn, pPrefs.t_type, p_dialog.cbDPSType.Text)
                                            CLDS_SetBlockAttr(xn, pPrefs.t_seg, p_dialog.cbDSeg.Text)
                                            xn.UpgradeOpen()
                                            CLDS_SetLayer(xn, pPrefs.l_updt, "Node " & xid)
                                            'xn.Layer = pPrefs.l_updt
                                        Else
                                            MsgBox("ERROR: point-segment " & xid & " is already at the selected position", MsgBoxStyle.Critical, "CMPIC " & e_mssg & " insertion error")
                                        End If
                                    Else
                                        If xty = "" Then
                                            MsgBox("ERROR: node " & xid & " is already at the selected position", MsgBoxStyle.Critical, "CMPIC " & e_mssg & " insertion error")
                                        Else
                                            MsgBox("ERROR: point-segment " & xid & " is already at the selected position", MsgBoxStyle.Critical, "CMPIC " & e_mssg & " insertion error")
                                        End If
                                    End If
                                Else
                                    Dim br As New BlockReference(np, nBlock)
                                    'Dim br As New BlockReference(xp, nBlock)
                                    Dim bpop As Point3d = br.Position
                                    CLDS_SetLayer(br, pPrefs.l_isrt, "Node")
                                    'br.Layer = pPrefs.l_isrt
                                    If p_dialog.cbIsMajor.Checked Then
                                        br.TransformBy(Matrix3d.Scaling(pPrefs.f_nodm, np))
                                    Else
                                        br.TransformBy(Matrix3d.Scaling(pPrefs.f_node, np))
                                    End If
                                    Dim bpnp As Point3d = br.Position
                                    btr.UpgradeOpen()
                                    btr.AppendEntity(br)
                                    xtrans.AddNewlyCreatedDBObject(br, True)
                                    Dim nMajor As String = "N"
                                    If p_dialog.cbIsMajor.Checked Then
                                        nMajor = "Y"
                                        CLDS_CloneBlock(xtrans, doc, pPrefs.b_nodm, nBlock, br)
                                    Else
                                        CLDS_CloneBlock(xtrans, doc, pPrefs.b_node, nBlock, br)
                                    End If
                                    CLDS_SetBlockAttr(br, t_id, nid)
                                    CLDS_SetBlockAttr(br, pPrefs.t_area, p_dialog.cbDArea.Text)
                                    CLDS_SetBlockAttr(br, pPrefs.t_comm, "")
                                    If p_ps Then
                                        CLDS_SetBlockAttr(br, pPrefs.t_type, p_dialog.cbDPSType.Text)
                                        CLDS_SetBlockAttr(br, pPrefs.t_seg, p_dialog.cbDSeg.Text)
                                        CLDS_SetBlockXRec(xtrans, br, nid, p_dialog.cbDPSType.Text, p_dialog.cbDSeg.Text, pPrefs.x_psln, nid, p_dialog.tbDRWay.Text, nMajor)
                                    Else
                                        CLDS_SetBlockAttr(br, pPrefs.t_type, "")
                                        CLDS_SetBlockAttr(br, pPrefs.t_seg, "")
                                        CLDS_SetBlockXRec(xtrans, br, nid, "", "", "", "", "", nMajor)
                                    End If
                                    CLDS_AddNode(xtrans, nd, nid, br.ObjectId)
                                    'CLDS_Static_Utils.CLDS_WriteMessage(ed, "Added " & e_mssg & " " & nid)
                                    pointing = False
                                End If
                            Else
                                adding = False
                                pointing = False
                            End If
                        End While
                    End If
                    xtrans.Commit()
                    Application.UpdateScreen()
                End Using
            End Using
        End While
    End Sub
    Public Sub CLDS_CreatePLNodes(ByVal p_dialog As CLDS_Network_Container, ByVal p_context As String, ByVal p_ps As Boolean, ByVal p_del As Boolean, Optional ByVal p_id As String = "")
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim cUCSM As Matrix3d = ed.CurrentUserCoordinateSystem
        Dim cUCS As CoordinateSystem3d = cUCSM.CoordinateSystem3d
        Dim plObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    plObj = sobj(0)
                Else
                    ed.WriteMessage(vbCrLf & "Too many entities selected")
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If plObj.IsNull Then
            CancelPrior()
            Dim peo As New PromptEntityOptions(vbLf & "Select polyline:")
            peo.SetRejectMessage("Polyline selection required." & vbCrLf)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Polyline), False)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Polyline3d), False)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Polyline2d), False)
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                plObj = per.ObjectId
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                Exit Sub
            End If
        End If
        Dim iRule As CLDS_Flex_Format = nRule
        If p_ps Then
            iRule = pRule
        End If

        If Not iRule Is Nothing Then
            iRule.Bind("A") = pNetDialog.cbDArea.Text
            iRule.Bind("P") = pNetDialog.cbDPSType.Text
            iRule.Bind("R") = pNetDialog.tbDRWay.Text
            iRule.Bind("S") = pNetDialog.cbDSeg.Text
            iRule.Bind("T") = pNetDialog.cbDType.Text
            If iRule.IndexFor("N") > 0 Then
                Dim p As String = iRule.Prompt_All(ed)
                If Mid$(p, 1, 4) = "QUIT" Then
                    Exit Sub
                End If
                If Mid$(p, 1, 6) = "ERROR:" Then
                    MsgBox(p, MsgBoxStyle.Critical, "CMPIC AutoCAD")
                    Exit Sub
                End If
            End If
        End If
        Dim pa As Point3dCollection = New Point3dCollection()
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using xtrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, xtrans, False)
                Dim bt As BlockTable = DirectCast(xtrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(xtrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                Dim nBlock As ObjectId
                If p_dialog.cbIsMajor.Checked Then
                    nBlock = CLDS_FindBlock(bt, doc, pPrefs.b_nodm)
                    If nBlock.IsNull Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "ERROR: Unable to locate major node block " & pPrefs.b_nodm & " for insertion")
                        Exit Sub
                    End If
                Else
                    nBlock = CLDS_FindBlock(bt, doc, pPrefs.b_node)
                    If nBlock.IsNull Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "ERROR: Unable to locate node block " & pPrefs.b_node & " for insertion")
                        Exit Sub
                    End If
                End If
                CLDS_CheckLayer(xtrans, doc, pPrefs.l_isrt, pPrefs.c_isrt)
                Dim obj As DBObject = xtrans.GetObject(plObj, OpenMode.ForRead)
                Dim ll As Line = TryCast(obj, Line)
                If ll IsNot Nothing Then
                    pa.Add(ll.StartPoint)
                    pa.Add(ll.EndPoint)
                    ll.UpgradeOpen()
                    If p_del Then
                        ll.Erase()
                        erased.Add(plObj)
                    Else
                        CLDS_CheckLayer(xtrans, doc, pPrefs.l_hide, pPrefs.c_hide)
                        CLDS_SetLayer(ll, pPrefs.l_hide, "Segment")
                        'll.Layer = pPrefs.l_hide
                    End If
                Else
                    ' If a "lightweight" (or optimized) polyline
                    Dim lwp As Polyline = TryCast(obj, Polyline)
                    If lwp IsNot Nothing Then
                        ' Use a for loop to get each vertex, one by one
                        Dim vn As Integer = lwp.NumberOfVertices
                        For i As Integer = 0 To vn - 1
                            ' Could also get the 3D point here
                            Dim pt As Point3d = lwp.GetPoint3dAt(i)
                            pa.Add(pt)
                        Next
                        lwp.UpgradeOpen()
                        If p_del Then
                            lwp.Erase()
                            erased.Add(plObj)
                        Else
                            CLDS_CheckLayer(xtrans, doc, pPrefs.l_hide, pPrefs.c_hide)
                            CLDS_SetLayer(lwp, pPrefs.l_hide, "Polyline")
                            'lwp.Layer = pPrefs.l_hide
                        End If
                    Else
                        ' If an old-style, 2D polyline
                        Dim p2d As Polyline2d = TryCast(obj, Polyline2d)
                        If p2d IsNot Nothing Then
                            ' Use foreach to get each contained vertex
                            For Each vId As ObjectId In p2d
                                Dim v2d As Vertex2d = DirectCast(xtrans.GetObject(vId, OpenMode.ForRead), Vertex2d)
                                Dim p3d As Point3d
                                If p_dialog.tbDZ.Text = "" Then
                                    p3d = New Point3d(v2d.Position.X, v2d.Position.Y, 0.0)
                                Else
                                    p3d = New Point3d(v2d.Position.X, v2d.Position.Y, Val(p_dialog.tbDZ.Text) * pPrefs.x_fact)
                                End If
                                'pa.Add(v2d.Position)
                                pa.Add(p3d)
                            Next
                            p2d.UpgradeOpen()
                            If p_del Then
                                p2d.Erase()
                                erased.Add(plObj)
                            Else
                                CLDS_CheckLayer(xtrans, doc, pPrefs.l_hide, pPrefs.c_hide)
                                CLDS_SetLayer(p2d, pPrefs.l_hide, "Polyline")
                                'p2d.Layer = pPrefs.l_hide
                            End If
                        Else
                            ' If an old-style, 3D polyline
                            Dim p3d As Polyline3d = TryCast(obj, Polyline3d)
                            If p3d IsNot Nothing Then
                                ' Use foreach to get each contained vertex
                                For Each vId As ObjectId In p3d
                                    Dim v3d As PolylineVertex3d = DirectCast(xtrans.GetObject(vId, OpenMode.ForRead), PolylineVertex3d)
                                    pa.Add(v3d.Position)
                                Next
                                p3d.UpgradeOpen()
                                If p_del Then
                                    p3d.Erase()
                                    erased.Add(plObj)
                                Else
                                    CLDS_CheckLayer(xtrans, doc, pPrefs.l_hide, pPrefs.c_hide)
                                    CLDS_SetLayer(p3d, pPrefs.l_hide, "Polyline")
                                    'p3d.Layer = pPrefs.l_hide
                                End If
                            Else
                                CLDS_Static_Utils.CLDS_WriteMessage(ed, "ERROR: no suitable line or polyline selected")
                            End If
                        End If
                    End If
                End If
                Dim cn As Integer = 0, cs As Integer = 0
                Dim nid As String = ""
                Dim pbr As BlockReference = Nothing
                Dim pid As String = ""
                Dim nRotate As Double = (pPrefs.a_node / 180.0) * 3.1415926538
                Dim joining As Boolean = True
                For Each xp As Point3d In pa
                    Dim np As Point3d = xp
                    Dim br As BlockReference = CLDS_FindNodeAtPosition(xtrans, nd, xp)
                    If br Is Nothing Then
                        nid = CLDS_NextNode(xtrans, nd, p_id, iRule)
                        If nid = "QUIT" Then
                            Exit For
                        End If
                        If nid = "-" Then
                            If p_ps Then
                                MsgBox("ERROR: unable to generate next point-segment ID", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                            Else
                                MsgBox("ERROR: unable to generate next node ID", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                            End If
                            Exit For
                        End If
                        br = New BlockReference(np, nBlock)
                        CLDS_SetLayer(br, pPrefs.l_isrt, "Node")
                        'br.Layer = pPrefs.l_isrt
                        If p_dialog.cbIsMajor.Checked Then
                            br.TransformBy(Matrix3d.Scaling(pPrefs.f_nodm, xp))
                        Else
                            br.TransformBy(Matrix3d.Scaling(pPrefs.f_node, xp))
                        End If
                        br.TransformBy(Matrix3d.Rotation(nRotate, cUCS.Zaxis, np))
                        btr.UpgradeOpen()
                        btr.AppendEntity(br)
                        xtrans.AddNewlyCreatedDBObject(br, True)
                        Dim nMajor As String = "N"
                        If p_dialog.cbIsMajor.Checked Then
                            nMajor = "Y"
                            CLDS_CloneBlock(xtrans, doc, pPrefs.b_nodm, nBlock, br)
                        Else
                            CLDS_CloneBlock(xtrans, doc, pPrefs.b_node, nBlock, br)
                        End If
                        CLDS_SetBlockAttr(br, pPrefs.t_node, nid)
                        CLDS_SetBlockAttr(br, pPrefs.t_area, p_dialog.cbDArea.Text)
                        CLDS_SetBlockAttr(br, pPrefs.t_comm, "")
                        If p_ps Then
                            CLDS_SetBlockAttr(br, pPrefs.t_type, p_dialog.cbDPSType.Text)
                            CLDS_SetBlockAttr(br, pPrefs.t_seg, p_dialog.cbDSeg.Text)
                            CLDS_SetBlockXRec(xtrans, br, nid, p_dialog.cbDPSType.Text, p_dialog.cbDSeg.Text, pPrefs.x_psln, nid, p_dialog.tbDRWay.Text, nMajor)
                        Else
                            CLDS_SetBlockAttr(br, pPrefs.t_type, "")
                            CLDS_SetBlockAttr(br, pPrefs.t_seg, "")
                            CLDS_SetBlockXRec(xtrans, br, nid, "", "", "", "", "", nMajor)
                        End If
                        CLDS_AddNode(xtrans, nd, nid, br.ObjectId)
                        ed.WriteMessage(vbCrLf & "Added node " & nid)
                        cn = cn + 1
                    Else
                        nid = CLDS_GetBlockAttr(br, pPrefs.t_node)
                    End If
                    If Not pid = "" Then
                        Dim xs As ObjectId = CLDS_FindSegment(xtrans, nd, pid, nid, 2)
                        If xs.IsNull Then
                            Dim nt As String, ns As String, nl As String
                            If p_ps Then
                                nt = pPrefs.n_jump
                                ns = ""
                            Else
                                If joining And (p_dialog.cbDType.Text = "" Or p_dialog.cbDSeg.Text = "") Then
                                    MsgBox("Please ensure default type and segregation set first", MsgBoxStyle.Exclamation, "CMPIC Join nodes")
                                    joining = False
                                Else
                                    nt = p_dialog.cbDType.Text
                                    ns = p_dialog.cbDSeg.Text
                                End If
                            End If
                            If joining Then
                                Dim sl As New Line(pbr.Position, br.Position)
                                sl.Thickness = pPrefs.x_lint
                                CLDS_SetLayer(sl, pPrefs.l_isrt, "Segment")
                                'sl.Layer = pPrefs.l_isrt
                                sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                                btr.AppendEntity(sl)
                                xtrans.AddNewlyCreatedDBObject(sl, True)
                                Dim l As Double = Math.Round((sl.Length / pPrefs.x_fact), 3)
                                nl = Trim(Str$(l))
                                Dim rw As String = p_dialog.tbDRWay.Text
                                If rw = "" Then
                                    rw = "-"
                                End If
                                CLDS_AddSegment(xtrans, nd, pid, nid, nt, ns, nl, sl.ObjectId, "-", rw)
                                ed.WriteMessage(vbCrLf & "Added segment " & pid & ":" & nid)
                                cs = cs + 1
                            End If
                        End If
                    End If
                    pid = nid
                    pbr = br
                Next
                xtrans.Commit()
                CLDS_Static_Utils.CLDS_WriteMessage(ed, Trim(Str$(cn)) & " new nodes, " & Trim(Str$(cs)) & " new segments")
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_JoinNodes(ByVal p_dialog As CLDS_Network_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        'If Not p_dialog.rbAddPS.Checked Then
        'If p_dialog.cbDType.Text = "" Or p_dialog.cbDSeg.Text = "" Then
        'MsgBox("Please ensure default type and segregation set first", MsgBoxStyle.Exclamation, "CMPIC Join nodes")
        'Exit Sub
        'End If
        'End If
        CancelPrior()
        Dim sobj() As ObjectId
        Dim nSelected As Integer = 0
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                sobj = psr.Value.GetObjectIds
                nSelected = sobj.GetLength(0)
                'Dim nobj() As ObjectId
                'ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception
            nSelected = 0
        End Try
        Dim joining As Boolean = True
        Dim first As Boolean = True
        Dim nodeB As BlockReference = Nothing, prevB As BlockReference = Nothing
        Dim i As Integer = 0
        While joining
            Using acLckDoc As DocumentLock = doc.LockDocument()
                Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                    Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                    Dim bt As BlockTable = DirectCast(nTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                    Dim btr As BlockTableRecord = DirectCast(nTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                    nodeB = Nothing
                    If i < nSelected Then
                        nodeB = CLDS_IsNode(nTrans, sobj(i))
                        If nodeB Is Nothing Then
                            Dim nobj() As ObjectId
                            ed.SetImpliedSelection(nobj)
                            nSelected = 0
                        End If
                    Else
                        If nSelected > 0 Then
                            Dim nobj() As ObjectId
                            ed.SetImpliedSelection(nobj)
                        End If
                    End If
                    If nodeB Is Nothing Then
                        nodeB = CLDS_PickNodeBlock(first)
                    End If
                    If nodeB Is Nothing Then
                        joining = False
                    ElseIf Not prevB Is Nothing Then
                        Dim n1 As String = CLDS_GetBlockAttr(prevB, pPrefs.t_node)
                        Dim n2 As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
                        If n1 = n2 Then
                            ed.WriteMessage(vbCrLf & "Node " & n1 & " already picked")
                        Else
                            Dim slObj As ObjectId = CLDS_FindSegment(nTrans, nd, n1, n2, 2)
                            If slObj.IsNull Then
                                Dim t1 As String = CLDS_GetBlockAttr(prevB, pPrefs.t_type)
                                Dim t2 As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_type)
                                Dim nt As String, ns As String, nl As String
                                If t1 <> "" Or t2 <> "" Then
                                    nt = pPrefs.n_jump
                                    ns = ""
                                Else
                                    If p_dialog.cbDType.Text = "" Or p_dialog.cbDSeg.Text = "" Then
                                        MsgBox("Please ensure default type and segregation set first", MsgBoxStyle.Exclamation, "CMPIC Join nodes")
                                        joining = False
                                    Else
                                        nt = p_dialog.cbDType.Text
                                        ns = p_dialog.cbDSeg.Text
                                    End If
                                End If
                                If joining Then
                                    Dim sl As New Line(prevB.Position, nodeB.Position)
                                    sl.Thickness = pPrefs.x_lint
                                    CLDS_CheckLayer(nTrans, doc, pPrefs.l_isrt, pPrefs.c_isrt, False)
                                    CLDS_SetLayer(sl, pPrefs.l_isrt, "Segment")
                                    'sl.Layer = pPrefs.l_isrt
                                    sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                                    sl.Thickness = pPrefs.x_lint
                                    btr.AppendEntity(sl)
                                    nTrans.AddNewlyCreatedDBObject(sl, True)
                                    Dim l As Double = Math.Round((sl.Length / pPrefs.x_fact), 3)
                                    nl = Trim(Str$(l))
                                    Dim rw As String = p_dialog.tbDRWay.Text
                                    If rw = "" Then
                                        rw = "-"
                                    End If
                                    CLDS_AddSegment(nTrans, nd, n1, n2, nt, ns, nl, sl.ObjectId, "-", rw)
                                    ed.WriteMessage(vbCrLf & "Added segment " & n1 & ":" & n2)
                                End If
                            Else
                                ed.WriteMessage(vbCrLf & "Nodes " & n1 & ":" & n2 & " already joined")
                            End If
                        End If
                    End If
                    prevB = nodeB
                    nTrans.Commit()
                    first = False
                End Using
            End Using
            Application.UpdateScreen()
            i = i + 1
        End While
        ed.WriteMessage(vbCrLf & "Command: ")
    End Sub
    Public Sub CLDS_BreakSegment(ByVal p_dialog As CLDS_Network_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim o_fnode As String = ""
        Dim o_tnode As String = ""
        Dim slObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    ed.WriteMessage(vbCrLf & "Too many entities selected")
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If slObj.IsNull Then
            Dim peo As New PromptEntityOptions(vbLf & "Select segment line:")
            peo.SetRejectMessage("Line or node block selection required." & vbCrLf)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Line), False)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                slObj = per.ObjectId
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                Exit Sub
            End If
        End If
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim cn As String = UCase(slObj.ObjectClass.Name)
                ed.WriteMessage(vbCrLf & "Picked: " & cn)
                If cn = "ACDBLINE" Then
                    Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                    Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                    If rb Is Nothing Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected line is not a CMPIC segment")
                        Exit Sub
                    End If
                    Dim ra As TypedValue() = rb.AsArray
                    o_fnode = ra(0).Value
                    o_tnode = ra(1).Value
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment " & o_fnode & ":" & o_tnode)
                    lineE.UpgradeOpen()
                    If lineE.Layer = pPrefs.l_dele Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment is marked for deletion")
                    ElseIf lineE.Layer = pPrefs.l_isrt Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment does not yet exist in CMPIC")
                        '               ElseIf lineE.Layer = pPrefs.l_updt Then
                        '                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment is marked for update")
                    Else
                        p_dialog.pgNProps.Visible = False
                        p_dialog.lvSBreaks.Visible = True
                        Dim breaking As Boolean = True
                        Dim nodeB As BlockReference = Nothing
                        CLDS_ShowBreakNodes(nTrans, lineE, p_dialog.lvSBreaks)
                        While breaking
                            nodeB = CLDS_PickNodeBlock(False)
                            If nodeB Is Nothing Then
                                breaking = False
                            Else
                                Dim nID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
                                If nID = o_fnode Then
                                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Cannot use segment from node as break point")
                                ElseIf nID = o_tnode Then
                                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Cannot use segment to node as break point")
                                Else
                                    CLDS_AddBreakNode(nTrans, doc, lineE, nodeB)
                                    CLDS_ShowBreakNodes(nTrans, lineE, p_dialog.lvSBreaks)
                                End If
                            End If
                        End While
                        p_dialog.lvSBreaks.Visible = False
                        p_dialog.pgNProps.Visible = True
                    End If
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Invalid selection")
                End If
                nTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_DeleteSegment(ByVal p_dialog As CLDS_Network_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim o_fnode As String = ""
        Dim o_tnode As String = ""
        Dim slObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    ed.WriteMessage(vbCrLf & "Too many entities selected")
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If slObj.IsNull Then
            Dim peo As New PromptEntityOptions(vbLf & "Select segment line:")
            peo.SetRejectMessage("Line or node block selection required." & vbCrLf)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Line), False)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                slObj = per.ObjectId
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                Exit Sub
            End If
        End If
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim cn As String = UCase(slObj.ObjectClass.Name)
                ed.WriteMessage(vbCrLf & "Picked: " & cn)
                If cn = "ACDBLINE" Then
                    Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                    Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                    If rb Is Nothing Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected line is not a CMPIC segment")
                        Exit Sub
                    End If
                    Dim ra As TypedValue() = rb.AsArray
                    o_fnode = ra(0).Value
                    o_tnode = ra(1).Value
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment " & o_fnode & ":" & o_tnode)
                    lineE.UpgradeOpen()
                    If lineE.Layer = pPrefs.l_dele Then
                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                        CLDS_SetLayer(lineE, pPrefs.l_updt, "Segment")
                        'lineE.Layer = pPrefs.l_updt
                    ElseIf lineE.Layer = pPrefs.l_isrt Then
                        lineE.Erase()
                        erased.Add(slObj)
                        CLDS_RemoveEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Segment_Key(o_fnode, o_tnode))
                    Else
                        CLDS_ClearAllBreaks(nTrans, lineE)
                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_dele, pPrefs.c_dele)
                        CLDS_SetLayer(lineE, pPrefs.l_dele, "Segment")
                        'lineE.Layer = pPrefs.l_dele
                    End If
                ElseIf cn = "ACDBBLOCKREFERENCE" Then
                    Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                    Dim nID As String = CLDS_GetBlockAttr(nodeB, "NODE")
                    Dim nType As String = CLDS_GetBlockAttr(nodeB, "TYPE")
                    If nID = "" Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected block is not a CMPIC node")
                        Exit Sub
                    Else
                        o_fnode = nID
                        o_tnode = nID
                        If nType = "" Then
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Node " & o_fnode)
                        Else
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Point-segment " & o_fnode)
                        End If
                    End If
                    nodeB.UpgradeOpen()
                    If nodeB.Layer = pPrefs.l_dele Then
                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                        CLDS_SetLayer(nodeB, pPrefs.l_updt, "Node")
                        'nodeB.Layer = pPrefs.l_updt
                    ElseIf nodeB.Layer = pPrefs.l_isrt Then
                        nodeB.Erase()
                        erased.Add(slObj)
                        CLDS_RemoveEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Node_Key(nID, nRule))
                    Else
                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_dele, pPrefs.c_dele)
                        CLDS_SetLayer(nodeB, pPrefs.l_dele, "Node")
                        'nodeB.Layer = pPrefs.l_dele
                    End If
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Invalid selection")
                End If
                nTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_DeleteMultiSegment(ByVal p_dialog As CLDS_Network_Container)
        If a_net.Count = 0 Then
            Exit Sub
        End If
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim o_fnode As String = ""
        Dim o_tnode As String = ""
        Dim slObj As ObjectId = ObjectId.Null
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                For i As Integer = 0 To a_net.Count - 1
                    Dim s As CLDS_Segment_Properties = DirectCast(a_net.Item(i), CLDS_Segment_Properties)
                    slObj = s.Obj
                    Dim cn As String = UCase(slObj.ObjectClass.Name)
                    If cn = "ACDBLINE" Then
                        'Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                        Dim lineE As Line = DirectCast(nTrans.GetObject(slObj, OpenMode.ForRead, True), Line)
                        Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                        If Not rb Is Nothing Then
                            Dim ra As TypedValue() = rb.AsArray
                            o_fnode = ra(0).Value
                            o_tnode = ra(1).Value
                            lineE.UpgradeOpen()
                            If lineE.Layer = pPrefs.l_dele Then
                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                CLDS_SetLayer(lineE, pPrefs.l_updt, "Segment")
                                'lineE.Layer = pPrefs.l_updt
                            ElseIf lineE.Layer = pPrefs.l_isrt Then
                                lineE.Erase()
                                erased.Add(slObj)
                                CLDS_RemoveEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Segment_Key(o_fnode, o_tnode))
                            Else
                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_dele, pPrefs.c_dele)
                                CLDS_SetLayer(lineE, pPrefs.l_dele, "Segment")
                                'lineE.Layer = pPrefs.l_dele
                            End If
                        End If
                    ElseIf cn = "ACDBBLOCKREFERENCE" Then
                        Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                        If nodeB.Name = pPrefs.b_dvce Then
                            Dim dID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_dvce)
                            nodeB.UpgradeOpen()
                            If nodeB.Layer = pPrefs.l_isrt Then
                                nodeB.Erase()
                                erased.Add(slObj)
                                CLDS_RemoveEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Node_Key(dID, nRule))
                            Else
                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                CLDS_SetLayer(nodeB, pPrefs.l_updt, "Node")
                                'nodeB.Layer = pPrefs.l_updt
                            End If
                        Else
                            Dim nID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
                            Dim nType As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_type)
                            If Not nID = "" Then
                                o_fnode = nID
                                o_tnode = nID
                                nodeB.UpgradeOpen()
                                If nodeB.Layer = pPrefs.l_dele Then
                                    CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                    CLDS_SetLayer(nodeB, pPrefs.l_updt, "Node")
                                    'nodeB.Layer = pPrefs.l_updt
                                ElseIf nodeB.Layer = pPrefs.l_isrt Then
                                    nodeB.Erase()
                                    erased.Add(slObj)
                                    CLDS_RemoveEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Node_Key(nID, nRule))
                                Else
                                    CLDS_CheckLayer(nTrans, doc, pPrefs.l_dele, pPrefs.c_dele)
                                    CLDS_SetLayer(nodeB, pPrefs.l_dele, "Node")
                                    'nodeB.Layer = pPrefs.l_dele
                                End If
                            End If
                        End If
                    End If
                Next
                nTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_ResetErrors(ByVal p_dialog As CLDS_Network_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim nl As String, nc As System.Drawing.Color
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nsr As PromptSelectionResult = CLDS_XSelectErrors(nTrans, ed)
                If Not nsr Is Nothing AndAlso Not nsr.Value Is Nothing Then
                    For Each objO As ObjectId In nsr.Value.GetObjectIds
                        Dim nodeB As BlockReference = CLDS_IsNode(nTrans, objO)
                        If nodeB Is Nothing Then
                            Dim devB As BlockReference = CLDS_IsDevice(nTrans, objO)
                            If devB Is Nothing Then
                                Dim segRB As ResultBuffer = CLDS_IsSegment(nTrans, objO)
                                If Not segRB Is Nothing Then
                                    Dim lineE As Line = DirectCast(objO.GetObject(OpenMode.ForRead), Line)
                                    nl = lineE.Layer
                                    If lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_isrt Then
                                        nl = pPrefs.l_isrt
                                        nc = pPrefs.c_isrt
                                    ElseIf Mid$(lineE.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_I_" Then
                                        nl = pPrefs.l_isrt
                                        nc = pPrefs.c_isrt
                                    ElseIf lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_updt Then
                                        nl = pPrefs.l_updt
                                        nc = pPrefs.c_updt
                                    ElseIf Mid$(lineE.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_U_" Then
                                        nl = pPrefs.l_updt
                                        nc = pPrefs.c_updt
                                    ElseIf lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_dele Then
                                        nl = pPrefs.l_dele
                                        nc = pPrefs.c_dele
                                    ElseIf Mid$(lineE.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_D_" Then
                                        nl = pPrefs.l_dele
                                        nc = pPrefs.c_dele
                                    ElseIf lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_jump Then
                                        nl = pPrefs.l_jump
                                        nc = pPrefs.c_jump
                                    ElseIf lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_sgmt Then
                                        nl = pPrefs.l_sgmt
                                        nc = pPrefs.c_sgmt
                                    ElseIf lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_used Then
                                        nl = pPrefs.l_used
                                        nc = pPrefs.c_used
                                    ElseIf lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_appd Then
                                        nl = pPrefs.l_appd
                                        nc = pPrefs.c_appd
                                    ElseIf lineE.Layer = pPrefs.l_eror & "_" & pPrefs.l_warn Then
                                        nl = pPrefs.l_warn
                                        nc = pPrefs.c_warn
                                    End If
                                    If nl <> lineE.Layer Then
                                        lineE.UpgradeOpen()
                                        CLDS_CheckLayer(nTrans, doc, nl, nc)
                                        CLDS_SetLayer(lineE, nl, "Segment")
                                        'lineE.Layer = nl
                                    End If
                                End If
                            Else
                                nl = devB.Layer
                                If devB.Layer = pPrefs.l_eror & "_" & pPrefs.l_isrt Then
                                    nl = pPrefs.l_isrt
                                    nc = pPrefs.c_isrt
                                ElseIf Mid$(devB.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_I_" Then
                                    nl = pPrefs.l_isrt
                                    nc = pPrefs.c_isrt
                                ElseIf devB.Layer = pPrefs.l_eror & "_" & pPrefs.l_updt Then
                                    nl = pPrefs.l_updt
                                    nc = pPrefs.c_updt
                                ElseIf Mid$(devB.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_U_" Then
                                    nl = pPrefs.l_updt
                                    nc = pPrefs.c_updt
                                ElseIf devB.Layer = pPrefs.l_eror & "_" & pPrefs.l_dele Then
                                    nl = pPrefs.l_dele
                                    nc = pPrefs.c_dele
                                ElseIf Mid$(devB.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_D_" Then
                                    nl = pPrefs.l_dele
                                    nc = pPrefs.c_dele
                                ElseIf devB.Layer = pPrefs.l_eror & "_" & pPrefs.l_dvce Then
                                    nl = pPrefs.l_dvce
                                    nc = pPrefs.c_dvce
                                End If
                                If nl <> devB.Layer Then
                                    devB.UpgradeOpen()
                                    CLDS_CheckLayer(nTrans, doc, nl, nc)
                                    CLDS_SetLayer(devB, nl, "Device")
                                    'devB.Layer = nl
                                End If
                            End If
                        Else
                            nl = nodeB.Layer
                            If nodeB.Layer = pPrefs.l_eror & "_" & pPrefs.l_isrt Then
                                nl = pPrefs.l_isrt
                                nc = pPrefs.c_isrt
                            ElseIf Mid$(nodeB.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_I_" Then
                                nl = pPrefs.l_isrt
                                nc = pPrefs.c_isrt
                            ElseIf nodeB.Layer = pPrefs.l_eror & "_" & pPrefs.l_updt Then
                                nl = pPrefs.l_updt
                                nc = pPrefs.c_updt
                            ElseIf Mid$(nodeB.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_U_" Then
                                nl = pPrefs.l_updt
                                nc = pPrefs.c_updt
                            ElseIf nodeB.Layer = pPrefs.l_eror & "_" & pPrefs.l_dele Then
                                nl = pPrefs.l_dele
                                nc = pPrefs.c_dele
                            ElseIf Mid$(nodeB.Layer, 1, Len(pPrefs.l_eror) + 3) = pPrefs.l_eror & "_D_" Then
                                nl = pPrefs.l_dele
                                nc = pPrefs.c_dele
                            ElseIf nodeB.Layer = pPrefs.l_eror & "_" & pPrefs.l_node Then
                                nl = pPrefs.l_node
                                nc = pPrefs.c_node
                            ElseIf nodeB.Layer = pPrefs.l_eror & "_" & pPrefs.l_nodm Then
                                nl = pPrefs.l_nodm
                                nc = pPrefs.c_nodm
                            End If
                            If nl <> nodeB.Layer Then
                                nodeB.UpgradeOpen()
                                CLDS_CheckLayer(nTrans, doc, nl, nc)
                                CLDS_SetLayer(nodeB, nl, "Node")
                                'nodeB.Layer = nl
                            End If
                        End If
                    Next
                End If
                nTrans.Commit()
            End Using
        End Using
    End Sub
    Public Function CLDS_ValidateNetwork(ByVal p_dialog As CLDS_Network_Container, Optional ByVal p_show As Boolean = True) As Boolean
        CLDS_ResetErrors(p_dialog)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        p_dialog.lbUpload.Text = ""
        p_dialog.lbUpload.Update()
        p_dialog.txLog.Text = ""
        p_dialog.txLog.Update()
        Dim e As Integer = 0, m As Integer = 0, d As Integer = 0, x As Integer = 0, a As Integer = 0
        Dim v As Boolean = True
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nsr As PromptSelectionResult = CLDS_XSelectAllNodes(nTrans, ed)
                If nsr.Value Is Nothing Then
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "No nodes to validate")
                    p_dialog.lbUpload.Text = "No nodes to validate"
                    p_dialog.lbUpload.Update()
                    v = False
                Else
                    Dim lnid As System.Collections.Generic.List(Of String) = New System.Collections.Generic.List(Of String)
                    Dim dnid As System.Collections.Generic.Dictionary(Of String, BlockReference) = New System.Collections.Generic.Dictionary(Of String, BlockReference)
                    For Each nodeO As ObjectId In nsr.Value.GetObjectIds
                        Dim nodeB As BlockReference = DirectCast(nTrans.GetObject(nodeO, OpenMode.ForRead), BlockReference)
                        Dim nid As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
                        Dim nl As String
                        If nid <> "" Then
                            If dnid.ContainsKey(nid) Then
                                ed.WriteMessage(vbCrLf & "Node " & nid & " duplicate found")
                                nl = nodeB.Layer
                                nodeB.UpgradeOpen()
                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_eror & "_" & nl, pPrefs.c_eror)
                                CLDS_SetLayer(nodeB, pPrefs.l_eror & "_" & nl, "Node " & nid)
                                'nodeB.Layer = pPrefs.l_eror & "_" & nl
                                x = x + 1
                                Dim otherB As BlockReference = dnid.Item(nid)
                                nl = otherB.Layer
                                If Not Mid$(nl, 1, Len(pPrefs.l_eror) + 1) = pPrefs.l_eror & "_" Then
                                    otherB.UpgradeOpen()
                                    CLDS_CheckLayer(nTrans, doc, pPrefs.l_eror & "_" & nl, pPrefs.c_eror)
                                    CLDS_SetLayer(otherB, pPrefs.l_eror & "_" & nl, "Node " & nid)
                                    'otherB.Layer = pPrefs.l_eror & "_" & nl
                                End If
                            Else
                                dnid.Add(nid, nodeB)
                            End If
                        End If
                    Next
                End If
                If v And x = 0 Then
                    Dim vsr As PromptSelectionResult = CLDS_XSelectValidateSegments(nTrans, ed)
                    If vsr.Value Is Nothing Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Nothing to validate")
                        p_dialog.lbUpload.Text = "Nothing to validate"
                        p_dialog.lbUpload.Update()
                        v = False
                    Else
                        Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                        Dim bt As BlockTable = DirectCast(nTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                        Dim btr As BlockTableRecord = DirectCast(nTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                        For Each lineO As ObjectId In vsr.Value.GetObjectIds
                            Dim lineE As Line = DirectCast(nTrans.GetObject(lineO, OpenMode.ForRead), Line)
                            Dim r1 As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                            Dim n1 As String = "", n2 As String = ""
                            If Not r1 Is Nothing Then
                                Dim t1 As TypedValue() = r1.AsArray
                                n1 = t1(0).Value : n2 = t1(1).Value
                                Dim nLayer As String = lineE.Layer
                                Dim nType As String = t1(2).Value
                                Dim nSeg As String = t1(3).Value
                                Dim nLen As String = t1(4).Value
                                Dim nSegID As String = t1(5).Value
                                Dim nRWayID As String = t1(6).Value
                                Dim no1 As ObjectId = CLDS_FindNode(nTrans, nd, n1)
                                Dim no2 As ObjectId = CLDS_FindNode(nTrans, nd, n2)
                                If no1.IsNull Or no2.IsNull Then
                                    ed.WriteMessage(vbCrLf & "Segment " & n1 & ":" & n2 & " node lookup error")
                                    lineE.UpgradeOpen()
                                    CLDS_CheckLayer(nTrans, doc, pPrefs.l_eror & "_" & nLayer, pPrefs.c_eror)
                                    CLDS_SetLayer(lineE, pPrefs.l_eror & "_" & nLayer, "Segment " & n1 & ":" & n2)
                                    'lineE.Layer = pPrefs.l_eror & "_" & nLayer
                                    e = e + 1
                                Else
                                    Dim ok As Boolean = True
                                    Dim nb1 As BlockReference = DirectCast(nTrans.GetObject(no1, OpenMode.ForRead), BlockReference)
                                    Dim nb2 As BlockReference = DirectCast(nTrans.GetObject(no2, OpenMode.ForRead), BlockReference)
                                    If nb1.Layer = pPrefs.l_dele Or nb2.Layer = pPrefs.l_dele Then
                                        lineE.UpgradeOpen()
                                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_dele, pPrefs.c_dele)
                                        CLDS_SetLayer(lineE, pPrefs.l_dele, "Segment " & n1 & ":" & n2)
                                        'lineE.Layer = pPrefs.l_dele
                                        d = d + 1
                                    Else
                                        If lineE.StartPoint.DistanceTo(nb1.Position) > pPrefs.x_prec Then
                                            lineE.UpgradeOpen()
                                            lineE.StartPoint = nb1.Position
                                            If Not (nb1.Layer = pPrefs.l_updt Or nb1.Layer = pPrefs.l_isrt Or nb1.Layer = pPrefs.l_dele) Then
                                                nb1.UpgradeOpen()
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                                CLDS_SetLayer(nb1, pPrefs.l_updt, "Node")
                                                'nb1.Layer = pPrefs.l_updt
                                            End If
                                            ok = False
                                        End If
                                        If lineE.EndPoint.DistanceTo(nb2.Position) > pPrefs.x_prec Then
                                            lineE.UpgradeOpen()
                                            lineE.EndPoint = nb2.Position
                                            If Not (nb2.Layer = pPrefs.l_updt Or nb2.Layer = pPrefs.l_isrt Or nb2.Layer = pPrefs.l_dele) Then
                                                nb2.UpgradeOpen()
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                                CLDS_SetLayer(nb2, pPrefs.l_updt, "Node")
                                                'nb2.Layer = pPrefs.l_updt
                                            End If
                                            ok = False
                                        End If
                                        Dim xLen As String = Trim(Str$(Math.Round((nb1.Position.DistanceTo(nb2.Position) / pPrefs.x_fact), 3)))
                                        If ok Then
                                            If (nb1.Layer = pPrefs.l_updt Or nb2.Layer = pPrefs.l_updt) And Not (xLen = nLen Or lineE.Layer = pPrefs.l_offr) Then
                                                lineE.UpgradeOpen()
                                                a = a + 1
                                                ok = False
                                            End If
                                        Else
                                            m = m + 1
                                        End If
                                        If Not ok Then
                                            If Not (lineE.Layer = pPrefs.l_isrt Or lineE.Layer = pPrefs.l_offr) Then
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                                CLDS_SetLayer(lineE, pPrefs.l_updt, "Segment")
                                                'lineE.Layer = pPrefs.l_updt
                                            End If
                                            nLen = xLen
                                            CLDS_AddSegment(nTrans, nd, n1, n2, nType, nSeg, nLen, lineO, nSegID, nRWayID)
                                        End If
                                    End If
                                End If
                            End If
                        Next
                    End If
                End If
                nTrans.Commit()
            End Using
        End Using
        If v Then
            Dim l As String = ""
            If x > 0 Then
                l = l & Chr(10) & "Found " & Str$(x) & " node " & IIf((x > 1), "errors", "error")
            End If
            If e > 0 Then
                l = l & Chr(10) & "Found " & Str$(e) & " segment " & IIf((e > 1), "errors", "error")
            End If
            If m > 0 Then
                l = l & Chr(10) & "Moved " & Str$(m) & " " & IIf((m > 1), "segments", "segment")
            End If
            If a > 0 Then
                l = l & Chr(10) & "Adjusted " & Str$(a) & " " & IIf((a > 1), "segments", "segment")
            End If
            If d > 0 Then
                l = l & Chr(10) & "Deleted " & Str$(d) & " " & IIf((d > 1), "segments", "segment")
            End If
            If l = "" Then
                If p_show Then
                    p_dialog.txLog.Text = "OK"
                    p_dialog.txLog.Update()
                Else
                    p_dialog.lbUpload.Text = "OK"
                    p_dialog.lbUpload.Update()
                End If
            Else
                p_dialog.txLog.Text = Mid$(l, 2)
                p_dialog.txLog.Update()
            End If
            ed.WriteMessage(vbCrLf & l & vbCrLf & "Command: ")
        End If
        If x > 0 Or e > 0 Then
            Return False
        Else
            Return True
        End If
        Application.UpdateScreen()
    End Function
    Public Sub CLDS_ShowMultiSegments(ByVal p_dialog As CLDS_Multirow_Container, ByVal ctx As String, ByVal nr As Integer, ByVal cc As String(,), ByVal ccc As Collection)
        p_dialog.tpMultiRow.SelectTab("tpMSegments")
        p_dialog.lvMultiSegment.Clear()
        p_dialog.lvMultiSegment.Columns.Add("Segment ID")
        p_dialog.lvMultiSegment.Columns.Add(CMAPI.CMUnitdesc)
        p_dialog.lvMultiSegment.Columns.Add("Tier")
        p_dialog.lvMultiSegment.Columns.Add("From")
        p_dialog.lvMultiSegment.Columns.Add("To")
        p_dialog.lvMultiSegment.Columns.Add("Raceway")
        p_dialog.lvMultiSegment.Columns.Add("Length [" & tokens("PD_LENUOM") & "]")
        p_dialog.lvMultiSegment.Columns.Add(tokens("PD_SGNAME"))
        p_dialog.lvMultiSegment.Columns.Add("Type")
        p_dialog.lvMultiSegment.Columns.Add("MT Type")
        p_dialog.lvMultiSegment.Columns.Add("No tiers")
        p_dialog.lvMultiSegment.Columns.Add("Vol Fill")
        p_dialog.lvMultiSegment.Columns.Add("Wgt Fill")
        p_dialog.lvMultiSegment.Columns.Add("Z From")
        p_dialog.lvMultiSegment.Columns.Add("Z To")
        For i As Integer = 1 To nr - 1
            Dim lvi As New System.Windows.Forms.ListViewItem
            lvi.Text = cc(ccc(ctx + "_ID"), i)                  '0
            lvi.SubItems.Add(cc(ccc(ctx + "_VESSEL"), i))       '1
            lvi.SubItems.Add(cc(ccc(ctx + "_TIERNO"), i))       '2
            lvi.SubItems.Add(cc(ccc(ctx + "_FROMNODE"), i))     '3
            lvi.SubItems.Add(cc(ccc(ctx + "_TONODE"), i))       '4
            lvi.SubItems.Add(cc(ccc(ctx + "_RACEWAYID"), i))    '5
            lvi.SubItems.Add(cc(ccc(ctx + "_LENGTH"), i))       '6
            lvi.SubItems.Add(cc(ccc(ctx + "_SEGREGATION"), i))  '7
            lvi.SubItems.Add(cc(ccc(ctx + "_NRTYPE"), i))       '8
            lvi.SubItems.Add(cc(ccc(ctx + "_MTTYPE"), i))       '9
            lvi.SubItems.Add(cc(ccc(ctx + "_TIER_COUNT"), i))   '10
            lvi.SubItems.Add(cc(ccc(ctx + "_FILL"), i))         '11
            lvi.SubItems.Add(cc(ccc(ctx + "_WTFILL"), i))       '12
            lvi.SubItems.Add(cc(ccc(ctx + "_FZ"), i))           '13
            lvi.SubItems.Add(cc(ccc(ctx + "_TZ"), i))           '14
            p_dialog.lvMultiSegment.Items.Add(lvi)
        Next
        For i As Integer = 0 To p_dialog.lvMultiSegment.Columns.Count - 1
            p_dialog.lvMultiSegment.Columns(i).Width = -2
        Next
        If CMAPI.CMUnits = 1 Then
            p_dialog.lvMultiSegment.Columns(1).Width = 0
        End If
        If tokens("PD_MULTITIER") <> "Y" Then
            p_dialog.lvMultiSegment.Columns(2).Width = 0
            p_dialog.lvMultiSegment.Columns(9).Width = 0
            p_dialog.lvMultiSegment.Columns(10).Width = 0
            p_dialog.lvMultiSegment.Columns(13).Width = 0
            p_dialog.lvMultiSegment.Columns(14).Width = 0
        End If
        p_dialog.lvMultiSegment.Update()
    End Sub
    Public Sub CLDS_SegmentDetail(ByVal p_dialog As CLDS_Segment_Container, ByVal p_segid As String, ByVal p_fnode As String, ByVal p_tnode As String, ByVal p_tier As Integer, Optional ByVal p_vessel As Integer = 0)
        Dim doc As Document
        Dim ed As Editor
        Dim v_vessel As Integer
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        p_dialog.tbSegID.Text = p_segid
        p_dialog.tbFromNode.Text = p_fnode
        p_dialog.tbToNode.Text = p_tnode
        p_dialog.tbLength.Text = ""
        Dim rb As RadioButton
        Dim lb As Label
        If p_tier > 0 Then
            rb = p_dialog.gbTiers.Controls.Item("rbTier" & Trim$(Str$(p_tier)))
            If Not rb.Checked Then
                rb.Checked = True
            End If
            lb = p_dialog.gbTiers.Controls.Item("lbTier" & Trim$(Str$(p_tier)))
        End If
        p_dialog.TB = p_tier
        p_dialog.tbRaceway.Text = ""
        p_dialog.tbSeg.Text = ""
        p_dialog.tbType.Text = ""
        p_dialog.tbStatus.Text = ""
        p_dialog.tbFill.Text = ""
        p_dialog.tbWtFill.Text = ""
        p_dialog.lvCables.Clear()
        If p_segid = "" And p_fnode = "" And p_tnode = "" Then
            If Not p_mcbdialog Is Nothing Then
                p_mcbdialog.lvMultiSegment.Clear()
                pHzPalette.Visible = False
            End If
            Exit Sub
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim rqr As String
        Dim id As String = p_segid
        If InStr(id, "=""") > 0 Then
            rqr = "QBE"
        Else
            rqr = "ST"
            If id = "" Then
                id = "FNODE=""" & p_fnode & """ TNODE=""" & p_tnode & """"
            Else
                id = "SEGID=""" & p_segid & """"
            End If
            If p_tier > 0 Then
                id = id & " TIER=""" & Trim$(Str$(p_tier)) & """"
            End If

        End If
        v_vessel = p_vessel
        Dim nr As Integer = CLDS_Query(ed, 1, "ST", rqr, id, sc, scc, v_vessel)
        If nr <= 0 Then
            If rqr = "QBE" Then
                p_dialog.tbStatus.Text = "No matching segment found"
            Else
                p_dialog.tbStatus.Text = "Segment not found in CMPIC"
            End If
            p_dialog.tbStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Bold)
            Exit Sub
        End If
        If nr > 2 Or (rqr = "QBE" And (CMAPI.CMUnits > 1 Or tokens("PD_MULTITIER") = "Y")) Then
            CLDS_CMPICHzPalette()
            CLDS_ShowMultiSegments(p_mcbdialog, rqr, nr, sc, scc)
            p_hzpalette.Visible = True
        End If
        p_dialog.Vessel = Val(sc(scc(rqr + "_VESSEL"), 1))
        p_dialog.TB = Val(sc(scc(rqr + "_TIERNO"), 1))
        p_dialog.tbSegID.Text = sc(scc(rqr & "_ID"), 1)
        p_dialog.tbFromNode.Text = sc(scc(rqr & "_FROMNODE"), 1)
        p_dialog.tbToNode.Text = sc(scc(rqr & "_TONODE"), 1)
        p_dialog.tbLength.Text = sc(scc(rqr & "_LENGTH"), 1)
        p_dialog.tbRaceway.Text = sc(scc(rqr & "_RACEWAYID"), 1)
        Dim nt As Integer = Val(sc(scc(rqr & "_TIER_COUNT"), 1))
        Dim st As String = ""
        For t As Integer = 1 To 9
            rb = p_dialog.gbTiers.Controls.Item("rbTier" & Trim$(Str$(t)))
            lb = p_dialog.gbTiers.Controls.Item("lbTier" & Trim$(Str$(t)))
            If nt = 1 And t = 1 Then
                p_dialog.lbTiers.Visible = False
                p_dialog.gbTiers.Visible = False
            ElseIf t <= nt Then
                p_dialog.lbTiers.Visible = True
                p_dialog.gbTiers.Visible = True
                rb.Visible = True
                lb.Visible = True
                If t = p_dialog.TB Then
                    rb.Checked = True
                Else
                    rb.Checked = False
                End If
            Else
                rb.Visible = False
                lb.Visible = False
            End If
        Next
        p_dialog.lbTiers.Update()
        p_dialog.gbTiers.Update()
        p_dialog.tbSeg.Text = sc(scc(rqr & "_SEGREGATION"), 1)
        p_dialog.tbType.Text = sc(scc(rqr & "_NRTYPE"), 1)
        p_dialog.tbStatus.Text = ""
        p_dialog.tbFill.Text = sc(scc(rqr & "_FILL"), 1)
        p_dialog.tbWtFill.Text = sc(scc(rqr & "_WTFILL"), 1)
        p_dialog.lbLength.Text = "Length [" + tokens("PD_LENUOM") + "]"
        p_dialog.lbSeg.Text = tokens("PD_SGNAME")
        p_dialog.ShowVessel()

        id = "FNODE=""" & p_dialog.tbFromNode.Text & """ TNODE=""" & p_dialog.tbToNode.Text & """"
        id = id & " TIER=""" & Trim$(Str$(p_dialog.TB)) & """"
        id = id & " FOCUS=""" & Trim$(Str$(p_dialog.Vessel)) & """"
        Dim cc(,) As String
        Dim ccc As Collection = Nothing
        nr = CLDS_Query(ed, 1, "ST", "CB", id, cc, ccc)
        If nr <= 0 Then
            st = ", no routed cables"
        End If
        Dim x As Double = Val(sc(scc(rqr & "_THRESHOLD"), 1))
        Dim f As Double = Val(sc(scc(rqr & "_FILL"), 1))
        If f > x Then
            st = st & ", fill exceeded"
        End If
        Dim l As String = sc(scc(rqr & "_FULLFLAG"), 1)
        If l = "Y" Then
            st = st & ", locked"
        End If
        If st <> "" Then
            p_dialog.tbStatus.Text = UCase(Mid$(st, 3, 1)) & Mid$(st, 4)
            p_dialog.tbStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Bold)
        End If
        If nr = 0 Then
            Exit Sub
        End If
        p_dialog.lvCables.Columns.Add("Cable ID")
        p_dialog.lvCables.Columns.Add(tokens("PD_UNITDESC"))
        p_dialog.lvCables.Columns.Add("From")
        p_dialog.lvCables.Columns.Add("To")
        p_dialog.lvCables.Columns.Add(tokens("PD_SYSNAME"))
        p_dialog.lvCables.Columns.Add(tokens("PD_SGNAME"))
        p_dialog.lvCables.Columns.Add(tokens("PD_CTNAME"))
        p_dialog.lvCables.Columns.Add("Status")
        For i As Integer = 1 To nr - 1
            Dim lvi As New System.Windows.Forms.ListViewItem
            lvi.Text = cc(ccc("CB_ID"), i)
            lvi.SubItems.Add(cc(ccc("CB_VESSEL"), i))
            lvi.SubItems.Add(cc(ccc("CB_FROMDEVICE"), i) & "@" & cc(ccc("CB_FROMNODE"), i))
            lvi.SubItems.Add(cc(ccc("CB_TODEVICE"), i) & "@" & cc(ccc("CB_TONODE"), i))
            lvi.SubItems.Add(cc(ccc("CB_SYSTEM"), i))
            lvi.SubItems.Add(cc(ccc("CB_SEGREGATION"), i))
            lvi.SubItems.Add(cc(ccc("CB_NSN"), i))
            lvi.SubItems.Add(cc(ccc("CB_ROUTESTATUS"), i))
            p_dialog.lvCables.Items.Add(lvi)
        Next
        For i As Integer = 0 To p_dialog.lvCables.Columns.Count - 1
            p_dialog.lvCables.Columns(i).Width = -2
        Next
        If CMAPI.CMUnits = 1 Then
            p_dialog.lvCables.Columns(1).Width = 0
        End If
        p_dialog.lvCables.Update()
    End Sub
    Public Sub CLDS_RefreshLists()
        If Not pNetDialog Is Nothing Then
            pNetDialog.Initialize(Me, "", False)
        End If
    End Sub
#End Region
#Region "Draw/Erase Network"
    Public Sub CLDS_ErasePartialNetwork(ByVal p_context As String, _
                                ByVal p_id As String, _
                                ByVal f_nc As TextBox, _
                                ByVal f_sc As TextBox, _
                                ByVal f_dc As TextBox)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor

        Dim v_nc As Integer = 0, v_sc As Integer = 0, v_dc As Integer = 0
        If Not f_nc Is Nothing Then
            f_nc.Text = Str$(v_nc)
            f_nc.Update()
        End If
        If Not f_sc Is Nothing Then
            f_sc.Text = Str$(v_sc)
            f_sc.Update()
        End If
        If Not f_dc Is Nothing Then
            f_dc.Text = Str$(v_dc)
            f_dc.Update()
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using sTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim sc(,) As String
                Dim scc As Collection = Nothing
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, sTrans, False)
                For i As Integer = 1 To 1000
                    Dim nr As Integer = CLDS_Query(ed, i, p_context, "SG", p_id, sc, scc)
                    If nr <= 0 Then
                        Exit For
                    End If
                    For r As Integer = 1 To nr - 1
                        Dim id1 As String = sc(scc("SG_FROMNODE"), r)
                        Dim id2 As String = sc(scc("SG_TONODE"), r)
                        If id1 <> id2 Then
                            Dim xlObj As ObjectId = CLDS_FindSegment(sTrans, nd, id1, id2)
                            If Not xlObj.IsNull Then
                                Dim xl As Line = TryCast(xlObj.GetObject(OpenMode.ForWrite), Line)
                                If Not xl Is Nothing Then
                                    xl.Erase()
                                    v_sc = v_sc - 1
                                    If Not f_sc Is Nothing Then
                                        f_sc.Text = Str$(v_sc)
                                        f_sc.Update()
                                    End If
                                    Dim k As String = CLDS_Segment_Key(id1, id2)
                                    CLDS_RemoveEntry(doc.Database, sTrans, k)
                                End If
                            End If
                        End If
                    Next
                Next
                sTrans.Commit()
            End Using
            Application.UpdateScreen()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nc(,) As String
                Dim ncc As Collection = Nothing
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                For i As Integer = 1 To 1000
                    Dim nr As Integer = CLDS_Query(ed, i, p_context, "ND", p_id, nc, ncc)
                    If nr <= 0 Then
                        Exit For
                    End If
                    For r As Integer = 1 To nr - 1
                        Dim nid As String = nc(ncc("ND_ID"), r)
                        Dim nmm As String = nc(ncc("ND_MAJOR"), r)
                        Dim br As BlockReference
                        Dim nObj As ObjectId = CLDS_FindNode(nTrans, nd, nid)
                        If Not nObj.IsNull Then
                            br = DirectCast(nTrans.GetObject(nObj, OpenMode.ForWrite), BlockReference)
                            br.Erase()
                            Dim k As String = CLDS_Node_Key(nid)
                            CLDS_RemoveEntry(doc.Database, nTrans, k)
                            If nmm = "D" Then
                                v_dc = v_dc - 1
                                If Not f_dc Is Nothing Then
                                    f_dc.Text = Str$(v_dc)
                                    f_dc.Update()
                                End If
                            Else
                                v_nc = v_nc - 1
                                If Not f_nc Is Nothing Then
                                    f_nc.Text = Str$(v_nc)
                                    f_nc.Update()
                                End If
                            End If
                        End If
                    Next
                Next
                nTrans.Commit()
            End Using
        End Using
        ed.WriteMessage(vbCrLf & "Command: ")
    End Sub
    Public Sub CLDS_EraseEntireNetwork(ByVal f_nc As TextBox, ByVal f_sc As TextBox, ByVal f_dc As TextBox)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                For Each lEntry As DBDictionaryEntry In nd
                    Dim xr As Xrecord = DirectCast(dTrans.GetObject(lEntry.Value, OpenMode.ForRead), Xrecord)
                    Try
                        If Not xr.IsDisposed Or xr.IsErased Then
                            If Not xr.Data Is Nothing Then
                                Dim rb As ResultBuffer = xr.Data
                                If Not rb Is Nothing AndAlso Not rb.IsDisposed Then
                                    Dim tv As TypedValue() = rb.AsArray
                                    Dim hn As Handle = New Handle(tv(0).Value)
                                    Dim x As ObjectId = nd.Database.GetObjectId(False, hn, 0)
                                    Dim e As Entity = x.GetObject(OpenMode.ForWrite)
                                    e.Erase()
                                    erased.Add(x)
                                End If
                            End If
                        End If
                        nd.Remove(lEntry.Key)
                    Catch ex As Exception
                    End Try
                Next
                dTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        If Not f_nc Is Nothing Then
            f_nc.Text = ""
            f_nc.Update()
        End If
        If Not f_sc Is Nothing Then
            f_sc.Text = ""
            f_sc.Update()
        End If
        If Not f_dc Is Nothing Then
            f_dc.Text = ""
            f_dc.Update()
        End If
    End Sub
    Public Sub CLDS_DrawNetwork(ByVal p_context As String, _
                                ByVal p_id As String, _
                                ByVal f_nc As TextBox, _
                                ByVal f_sc As TextBox, _
                                ByVal f_dc As TextBox)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim cUCSM As Matrix3d = ed.CurrentUserCoordinateSystem
        Dim cUCS As CoordinateSystem3d = cUCSM.CoordinateSystem3d

        Dim v_nc As Integer = 0, v_sc As Integer = 0, v_dc As Integer = 0
        If Not f_nc Is Nothing Then
            f_nc.Text = Str$(v_nc)
            f_nc.Update()
        End If
        If Not f_sc Is Nothing Then
            f_sc.Text = Str$(v_sc)
            f_sc.Update()
        End If
        If Not f_dc Is Nothing Then
            f_dc.Text = Str$(v_dc)
            f_dc.Update()
        End If
        bWCSUCS = False
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                CLDS_SetOrigin(nTrans)
                Dim nc(,) As String
                Dim ncc As Collection = Nothing
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim bt As BlockTable = DirectCast(nTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(nTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                Dim nRotate As Double = (pPrefs.a_node / 180.0) * 3.1415926538
                Dim dRotate As Double = (pPrefs.a_dvce / 180.0) * 3.1415926538
                For i As Integer = 1 To 1000
                    Dim nr As Integer = CLDS_Query(ed, i, p_context, "ND", p_id, nc, ncc)
                    If nr <= 0 Then
                        Exit For
                    End If
                    Dim nBlock As ObjectId, nMajor As ObjectId, nDevice As ObjectId
                    If i = 1 Then
                        nBlock = CLDS_FindBlock(bt, doc, pPrefs.b_node)
                        If nBlock.IsNull Then
                            ed.WriteMessage(vbCrLf & "ERROR: Unable to locate node block " & pPrefs.b_node & " for insertion")
                            Exit For
                        End If
                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_node, pPrefs.c_node)
                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_nodm, pPrefs.c_nodm)
                        If pPrefs.b_node = pPrefs.b_nodm Then
                            nMajor = nBlock
                        Else
                            nMajor = CLDS_FindBlock(bt, doc, pPrefs.b_nodm)
                            If nMajor.IsNull Then
                                ed.WriteMessage(vbCrLf & "ERROR: Unable to locate major node block " & pPrefs.b_nodm & " for insertion")
                                Exit For
                            End If
                        End If
                        nDevice = CLDS_FindBlock(bt, doc, pPrefs.b_dvce)
                        If nDevice.IsNull Then
                            ed.WriteMessage(vbCrLf & "ERROR: Unable to locate device block " & pPrefs.b_dvce & " for insertion")
                            Exit For
                        End If
                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_dvce, pPrefs.c_dvce)
                    End If
                    For r As Integer = 1 To nr - 1
                        Dim nid As String = nc(ncc("ND_ID"), r)
                        Dim nx As Double = ((Val(nc(ncc("ND_X"), r)) - X_CMPIC) * pPrefs.x_fact)
                        Dim ny As Double = ((Val(nc(ncc("ND_Y"), r)) - Y_CMPIC) * pPrefs.x_fact)
                        If Math.Abs(A_LOCAL) > 0 Then
                            Dim sinA As Double = Math.Sin(A_LOCAL * Math.PI / 180.0)
                            Dim cosA As Double = Math.Cos(A_LOCAL * Math.PI / 180.0)
                            Dim tx As Double = (nx * cosA) - (ny * sinA)
                            Dim ty As Double = (nx * sinA) + (ny * cosA)
                            nx = tx
                            ny = ty
                        End If
                        nx = nx + X_LOCAL
                        ny = ny + Y_LOCAL
                        Dim nz As Double = Val(nc(ncc("ND_Z"), r)) * pPrefs.x_fact
                        Dim na As String = nc(ncc("ND_AREA"), r)
                        Dim nt As String = nc(ncc("ND_COMMENTS"), r)
                        Dim xp As Point3d = New Point3d(nx, ny, nz)
                        Dim np As Point3d = xp
                        Dim nmm As String = nc(ncc("ND_MAJOR"), r)
                        If nmm = "D" Then
                            v_dc = v_dc + 1
                            If Not f_dc Is Nothing Then
                                f_dc.Text = Str$(v_dc)
                                f_dc.Update()
                            End If
                            Dim br As BlockReference
                            Dim nObj As ObjectId = CLDS_FindNode(nTrans, nd, nid)
                            If nObj.IsNull Then
                                br = New BlockReference(np, nDevice)
                                CLDS_SetLayer(br, pPrefs.l_dvce, "Device " & nid)
                                'br.Layer = pPrefs.l_dvce
                                br.TransformBy(Matrix3d.Scaling(pPrefs.f_dvce, np))
                                br.TransformBy(Matrix3d.Rotation(dRotate, cUCS.Zaxis, np))
                                btr.AppendEntity(br)
                                nTrans.AddNewlyCreatedDBObject(br, True)
                                CLDS_CloneBlock(nTrans, doc, pPrefs.b_dvce, nDevice, br)
                                CLDS_SetBlockAttr(br, pPrefs.t_dvce, nid)
                                CLDS_SetBlockAttr(br, pPrefs.t_area, na)
                                CLDS_SetBlockAttr(br, pPrefs.t_comm, nt)
                                CLDS_AddNode(nTrans, nd, nid, br.ObjectId)
                            Else
                                br = DirectCast(nTrans.GetObject(nObj, OpenMode.ForWrite), BlockReference)
                                CLDS_SetLayer(br, pPrefs.l_dvce, "Device " & nid)
                                'br.Layer = pPrefs.l_dvce
                                CLDS_SetBlockAttr(br, pPrefs.t_area, na)
                            End If
                            CLDS_SetBlockXRec(nTrans, br, nid, "", "", "", "", "", "Y")
                        ElseIf nmm = "Y" Then
                            v_nc = v_nc + 1
                            If Not f_nc Is Nothing Then
                                f_nc.Text = Str$(v_nc)
                                f_nc.Update()
                            End If
                            Dim br As BlockReference
                            Dim nObj As ObjectId = CLDS_FindNode(nTrans, nd, nid)
                            If nObj.IsNull Then
                                br = New BlockReference(np, nMajor)
                                CLDS_SetLayer(br, pPrefs.l_nodm, "Major node " & nid)
                                'br.Layer = pPrefs.l_nodm
                                br.TransformBy(Matrix3d.Scaling(pPrefs.f_nodm, np))
                                br.TransformBy(Matrix3d.Rotation(nRotate, cUCS.Zaxis, np))
                                btr.AppendEntity(br)
                                nTrans.AddNewlyCreatedDBObject(br, True)
                                CLDS_CloneBlock(nTrans, doc, pPrefs.b_nodm, nBlock, br)
                                CLDS_SetBlockAttr(br, pPrefs.t_node, nid)
                                CLDS_SetBlockAttr(br, pPrefs.t_type, "")
                                CLDS_SetBlockAttr(br, pPrefs.t_area, na)
                                CLDS_SetBlockAttr(br, pPrefs.t_comm, nt)
                                CLDS_SetBlockAttr(br, pPrefs.t_seg, "")
                                CLDS_AddNode(nTrans, nd, nid, br.ObjectId)
                            Else
                                br = DirectCast(nTrans.GetObject(nObj, OpenMode.ForWrite), BlockReference)
                                CLDS_SetLayer(br, pPrefs.l_nodm, "Major node " & nid)
                                'br.Layer = pPrefs.l_nodm
                                CLDS_SetBlockAttr(br, pPrefs.t_area, na)
                            End If
                            CLDS_SetBlockXRec(nTrans, br, nid, "", "", "", "", "", nmm)
                        Else
                            v_nc = v_nc + 1
                            If Not f_nc Is Nothing Then
                                f_nc.Text = Str$(v_nc)
                                f_nc.Update()
                            End If
                            Dim br As BlockReference
                            Dim nObj As ObjectId = CLDS_FindNode(nTrans, nd, nid)
                            If nObj.IsNull Then
                                br = New BlockReference(np, nBlock)
                                CLDS_SetLayer(br, pPrefs.l_node, "Node " & nid)
                                'br.Layer = pPrefs.l_node
                                br.TransformBy(Matrix3d.Scaling(pPrefs.f_node, np))
                                br.TransformBy(Matrix3d.Rotation(nRotate, cUCS.Zaxis, np))
                                btr.AppendEntity(br)
                                nTrans.AddNewlyCreatedDBObject(br, True)
                                CLDS_CloneBlock(nTrans, doc, pPrefs.b_node, nBlock, br)
                                CLDS_SetBlockAttr(br, pPrefs.t_node, nid)
                                CLDS_SetBlockAttr(br, pPrefs.t_type, "")
                                CLDS_SetBlockAttr(br, pPrefs.t_area, na)
                                CLDS_SetBlockAttr(br, pPrefs.t_comm, nt)
                                CLDS_SetBlockAttr(br, pPrefs.t_seg, "")
                                CLDS_AddNode(nTrans, nd, nid, br.ObjectId)
                            Else
                                br = DirectCast(nTrans.GetObject(nObj, OpenMode.ForWrite), BlockReference)
                                CLDS_SetLayer(br, pPrefs.l_node, "Node " & nid)
                                'br.Layer = pPrefs.l_node
                                CLDS_SetBlockAttr(br, pPrefs.t_area, na)
                                CLDS_SetBlockAttr(br, pPrefs.t_comm, nt)
                            End If
                            CLDS_SetBlockXRec(nTrans, br, nid, "", "", "", "", "", nmm)
                        End If
                    Next
                Next
                nTrans.Commit()
            End Using
            Application.UpdateScreen()
            Dim erased As ObjectIdCollection = New ObjectIdCollection
            Using sTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim sc(,) As String
                Dim scc As Collection = Nothing
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, sTrans, False)
                Dim bt As BlockTable = DirectCast(sTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(sTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                For i As Integer = 1 To 1000
                    Dim nr As Integer = CLDS_Query(ed, i, p_context, "SG", p_id, sc, scc)
                    If nr <= 0 Then
                        Exit For
                    End If
                    If i = 1 Then
                        CLDS_CheckLayer(sTrans, doc, pPrefs.l_warn, pPrefs.c_warn)
                        CLDS_CheckLayer(sTrans, doc, pPrefs.l_appd, pPrefs.c_appd)
                        CLDS_CheckLayer(sTrans, doc, pPrefs.l_used, pPrefs.c_used)
                        CLDS_CheckLayer(sTrans, doc, pPrefs.l_offr, pPrefs.c_offr)
                        CLDS_CheckLayer(sTrans, doc, pPrefs.l_jump, pPrefs.c_jump)
                        CLDS_CheckLayer(sTrans, doc, pPrefs.l_sgmt, pPrefs.c_sgmt)
                    End If
                    For r As Integer = 1 To nr - 1
                        v_sc = v_sc + 1
                        If Not f_sc Is Nothing Then
                            f_sc.Text = Str$(v_sc)
                            f_sc.Update()
                        End If
                        Dim id1 As String = sc(scc("SG_FROMNODE"), r)
                        Dim id2 As String = sc(scc("SG_TONODE"), r)
                        Dim nObj1 As ObjectId = CLDS_FindNode(sTrans, nd, id1)
                        Dim nObj2 As ObjectId = CLDS_FindNode(sTrans, nd, id2)
                        If Not (nObj1.IsNull Or nObj2.IsNull) Then
                            Dim n1 As BlockReference = TryCast(nObj1.GetObject(OpenMode.ForRead), BlockReference)
                            Dim n2 As BlockReference = TryCast(nObj2.GetObject(OpenMode.ForRead), BlockReference)
                            If Not (n1 Is Nothing Or n2 Is Nothing) Then
                                Dim nt As String = sc(scc("SG_NRTYPE"), r)
                                Dim ns As String = sc(scc("SG_SEGREGATION"), r)
                                Dim nl As String = sc(scc("SG_LENGTH"), r)
                                Dim st As Integer = Val(sc(scc("SG_RTSTATUS"), r))
                                Dim si As String = sc(scc("SG_ID"), r)
                                Dim ri As String = sc(scc("SG_RACEWAYID"), r)
                                Dim rf As String = sc(scc("SG_OVERFILL"), r)
                                Dim rl As String = sc(scc("SG_LOCKED"), r)
                                Dim mj As String = "Y"
                                If scc.Contains("SG_MAJOR") Then
                                    mj = sc(scc("SG_MAJOR"), r)
                                End If
                                Dim nz As String = "0"
                                If scc.Contains("SG_ARZONE") Then
                                    nz = sc(scc("SG_ARZONE"), r)
                                End If
                                Dim sx As String = "-1"
                                If scc.Contains("SG_COLOUR") Then
                                    sx = sc(scc("SG_COLOUR"), r)
                                End If
                                If id1 = id2 Then
                                    n1.UpgradeOpen()
                                    CLDS_SetBlockAttr(n1, pPrefs.t_type, nt)
                                    CLDS_SetBlockAttr(n1, pPrefs.t_seg, ns)
                                    CLDS_SetBlockXRec(sTrans, n1, id1, nt, ns, nl, si, ri, mj)
                                    If nz = "0" Then
                                        If rf <> "0" Or rl <> "0" Then
                                            CLDS_SetLayer(n1, pPrefs.l_warn, "Point-segment " & id1)
                                            'n1.Layer = pPrefs.l_warn
                                        ElseIf st >= 30 And p_netdialog.cbShowApproved.Checked Then
                                            CLDS_SetLayer(n1, pPrefs.l_appd, "Point-segment " & id1)
                                            'n1.Layer = pPrefs.l_appd
                                        ElseIf st > 0 And p_netdialog.cbShowRouted.Checked Then
                                            CLDS_SetLayer(n1, pPrefs.l_used, "Point-segment " & id1)
                                            'n1.Layer = pPrefs.l_used
                                        ElseIf sx <> "-1" And p_netdialog.cbShowSeg.Checked Then
                                            Allocate(sTrans, doc, pPrefs.l_sgmt & "_" & sx, pPrefs.c_sgmt, Val(sx) + 1)
                                            CLDS_SetLayer(n1, pPrefs.l_sgmt & "_" & sx, "Point-segment " & id1)
                                            'n1.Layer = pPrefs.l_sgmt & "_" & sx
                                        Else
                                            CLDS_SetLayer(n1, pPrefs.l_sgmt, "Point-segment " & id1)
                                            'n1.Layer = pPrefs.l_sgmt
                                        End If
                                    Else
                                        Allocate(sTrans, doc, pPrefs.l_sgmt & "_" & nz, pPrefs.c_sgmt, nz)
                                        CLDS_SetLayer(n1, pPrefs.l_sgmt & "_" & nz, "Point-segment " & id1)
                                        'n1.Layer = pPrefs.l_sgmt & "_" & nz
                                    End If
                                Else
                                    Dim xlObj As ObjectId = CLDS_FindSegment(sTrans, nd, id1, id2)
                                    If Not xlObj.IsNull Then
                                        Dim xl As Line = TryCast(xlObj.GetObject(OpenMode.ForWrite), Line)
                                        If Not xl Is Nothing Then
                                            xl.Erase()
                                            erased.Add(xlObj)
                                        End If
                                    End If
                                    Dim sl As New Line(n1.Position, n2.Position)
                                    sl.Thickness = pPrefs.x_lint
                                    If rf <> "0" Or rl <> "0" Then
                                        CLDS_SetLayer(sl, pPrefs.l_warn, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_warn
                                    ElseIf st >= 30 And p_netdialog.cbShowApproved.Checked Then
                                        CLDS_SetLayer(sl, pPrefs.l_appd, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_appd
                                    ElseIf st > 0 And p_netdialog.cbShowRouted.Checked Then
                                        CLDS_SetLayer(sl, pPrefs.l_used, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_used
                                    ElseIf nt = pPrefs.n_offr Then
                                        CLDS_SetLayer(sl, pPrefs.l_offr, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_offr
                                    ElseIf nt = pPrefs.n_jump Then
                                        CLDS_SetLayer(sl, pPrefs.l_jump, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_jump
                                    ElseIf nz <> "0" Then
                                        Allocate(sTrans, doc, pPrefs.l_sgmt & "_" & nz, pPrefs.c_sgmt, nz)
                                        CLDS_SetLayer(sl, pPrefs.l_sgmt & "_" & nz, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_sgmt & "_" & nz
                                    ElseIf sx <> "-1" And p_netdialog.cbShowSeg.Checked Then
                                        Allocate(sTrans, doc, pPrefs.l_sgmt & "_" & sx, pPrefs.c_sgmt, Val(sx) + 1)
                                        CLDS_SetLayer(sl, pPrefs.l_sgmt & "_" & sx, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_sgmt & "_" & sx
                                    Else
                                        CLDS_SetLayer(sl, pPrefs.l_sgmt, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = pPrefs.l_sgmt
                                    End If
                                    sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                                    btr.AppendEntity(sl)
                                    sTrans.AddNewlyCreatedDBObject(sl, True)
                                    CLDS_AddSegment(sTrans, nd, id1, id2, nt, ns, nl, sl.ObjectId, si, ri)
                                End If
                            End If
                        End If
                    Next
                Next
                sTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        ed.WriteMessage(vbCrLf & "Command: ")
    End Sub
    Public Sub CLDS_ShowOffRoute(ByVal p_devid As String, ByVal p_node As String, ByVal p_len As Double, ByVal p_show As Boolean, Optional ByVal p_delete As Boolean = True)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim id1 As String = p_devid
        Dim id2 As String = p_node
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using sTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, sTrans, False)
                Dim bt As BlockTable = DirectCast(sTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(sTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                If p_show Then
                    Dim nObj1 As ObjectId = CLDS_FindNode(sTrans, nd, id1)
                    Dim nObj2 As ObjectId = CLDS_FindNode(sTrans, nd, id2)
                    If Not (nObj1.IsNull Or nObj2.IsNull) Then
                        Dim n1 As BlockReference = TryCast(nObj1.GetObject(OpenMode.ForRead), BlockReference)
                        Dim n2 As BlockReference = TryCast(nObj2.GetObject(OpenMode.ForRead), BlockReference)
                        If Not (n1 Is Nothing Or n2 Is Nothing) Then
                            Dim nt As String = pPrefs.n_offr
                            Dim ns As String = "-"
                            Dim nl As String = Trim(Str$(p_len))
                            Dim st As Integer = 0
                            Dim si As String = ""
                            Dim ri As String = ""
                            Dim rf As String = ""
                            Dim rl As String = ""
                            Dim xlObj As ObjectId = CLDS_FindSegment(sTrans, nd, id1, id2)
                            If Not xlObj.IsNull Then
                                Dim xl As Line = TryCast(xlObj.GetObject(OpenMode.ForWrite), Line)
                                If Not xl Is Nothing Then
                                    xl.Erase()
                                    erased.Add(xlObj)
                                End If
                            End If
                            Dim sl As New Line(n1.Position, n2.Position)
                            sl.Thickness = pPrefs.x_lint
                            CLDS_CheckLayer(sTrans, doc, pPrefs.l_offr, pPrefs.c_offr)
                            CLDS_SetLayer(sl, pPrefs.l_offr, "Off-route segment")
                            'sl.Layer = pPrefs.l_offr
                            sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                            btr.AppendEntity(sl)
                            sTrans.AddNewlyCreatedDBObject(sl, True)
                            CLDS_AddSegment(sTrans, nd, id1, id2, nt, ns, nl, sl.ObjectId, si, ri)
                        End If
                    End If
                Else
                    Dim xlObj As ObjectId = CLDS_FindSegment(sTrans, nd, id1, id2, 2)
                    If Not xlObj.IsNull Then
                        Dim xl As Line = TryCast(xlObj.GetObject(OpenMode.ForWrite), Line)
                        If Not xl Is Nothing Then
                            Dim rb As ResultBuffer = CLDS_GetXRecord(sTrans, xl)
                            If Not rb Is Nothing Then
                                Dim ra As TypedValue() = rb.AsArray
                                Dim o_fnode As String = ra(0).Value
                                Dim o_tnode As String = ra(1).Value
                                xl.UpgradeOpen()
                                If p_delete Then
                                    xl.Erase()
                                    erased.Add(xlObj)
                                    CLDS_RemoveEntry(doc.Database, sTrans, CLDS_Static_Utils.CLDS_Segment_Key(o_fnode, o_tnode))
                                Else
                                    CLDS_CheckLayer(sTrans, doc, pPrefs.l_dele, pPrefs.c_dele)
                                    CLDS_SetLayer(xl, pPrefs.l_dele, "Segment " & o_fnode & ":" & o_tnode)
                                    'xl.Layer = pPrefs.l_dele
                                End If
                            End If
                        End If
                    End If
                End If
                sTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
#End Region
#Region "Device and near-nodes"
    Public Sub CLDS_DeviceDetail(ByVal p_dialog As CLDS_Network_Container, ByVal p_devid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        p_dialog.tbDevID.Text = p_devid
        p_dialog.tbDesc.Text = ""
        p_dialog.tbSystem.Text = ""
        p_dialog.tbArea.Text = ""
        p_dialog.lvNNodes.Clear()
        If p_devid = "" Then
            Exit Sub
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim id As String
        id = "DEVID=""" & p_devid & """"
        id = id & " FOCUS=""" & Trim$(Str$(pProps.v_focus)) & """"
        Dim nr As Integer = CLDS_Query(ed, 1, "DW", "DV", id, sc, scc)
        If nr <= 0 Then
            p_dialog.tbStatus.Text = "ERROR: device not found"
            p_dialog.tbStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Bold)
            Exit Sub
        End If
        p_dialog.tbDevID.Text = sc(scc("DV_ID"), 1)
        p_dialog.tbDesc.Text = sc(scc("DV_DESC"), 1)
        p_dialog.tbSystem.Text = sc(scc("DV_SYSTEM"), 1)
        p_dialog.tbArea.Text = sc(scc("DV_COMPARTMENT"), 1)
        p_dialog.tbStatus.Text = ""
        p_dialog.gbDevice.Update()
        Dim lvgExisting As New ListViewGroup("Existing", "Existing"), lvgNew As New ListViewGroup("New", "New"), lvgUpdated As New ListViewGroup("Updated", "Updated"), lvgDeleted As New ListViewGroup("Deleted", "Deleted")
        p_dialog.lvNNodes.Groups.Add(lvgExisting)
        p_dialog.lvNNodes.Groups.Add(lvgNew)
        p_dialog.lvNNodes.Groups.Add(lvgUpdated)
        p_dialog.lvNNodes.Groups.Add(lvgDeleted)
        p_dialog.lvNNodes.Columns.Add("Node ID")
        p_dialog.lvNNodes.Columns.Add("Area")
        p_dialog.lvNNodes.Columns.Add("Off-route [m]")
        p_dialog.lvNNodes.Columns.Add("Default")
        p_dialog.lvNNodes.Columns.Add("# Cables")
        p_dialog.lvNNodes.Columns.Add("Vector [m]")
        p_dialog.lvNNodes.Columns.Add("Delta [m]")
        Dim cc(,) As String
        Dim ccc As Collection = Nothing
        id = p_devid
        nr = CLDS_Query(ed, 1, "DV", "ND", id, cc, ccc)
        If nr <= 0 Then
            p_dialog.tbStatus.Text = "No near nodes"
            p_dialog.tbStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Bold)
            Exit Sub
        End If
        For i As Integer = 1 To nr - 1
            Dim lvi As New System.Windows.Forms.ListViewItem
            lvi.Group = lvgExisting
            lvi.Text = cc(ccc("ND_ID"), i)
            lvi.SubItems.Add(cc(ccc("ND_AREA"), i))
            lvi.SubItems.Add(cc(ccc("ND_OFFROUTE"), i))
            lvi.SubItems.Add(cc(ccc("ND_DEFAULT"), i))
            lvi.SubItems.Add(cc(ccc("ND_USED"), i))
            lvi.SubItems.Add(cc(ccc("ND_VECTOR"), i))
            lvi.SubItems.Add(cc(ccc("ND_DELTA"), i))
            p_dialog.lvNNodes.Items.Add(lvi)
        Next
        For i As Integer = 0 To p_dialog.lvNNodes.Columns.Count - 1
            p_dialog.lvNNodes.Columns(i).Width = -2
        Next
        p_dialog.lvNNodes.Update()
    End Sub
    Public Sub CLDS_AddNearNode(ByVal p_dialog As CLDS_Network_Container, Optional ByVal p_nid As String = "")
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim v_nid As String = p_nid
        CLDS_PickNode(v_nid)
        If v_nid = "" Then
            Exit Sub
        End If
        Dim v_did As String = p_dialog.tbDevID.Text
        If v_did = "" Then
            Exit Sub
        End If
        Dim lv As ListView = p_dialog.lvNNodes
        For Each xlvi As ListViewItem In lv.Items
            If xlvi.Text = v_nid Then
                MsgBox("Node " & v_nid & " is already a near-node for device " & v_did, MsgBoxStyle.Exclamation)
                Exit Sub
            End If
        Next
        Dim nr As Integer
        Dim cc(,) As String
        Dim ccc As Collection = Nothing
        Dim id As String = "NODEID=""" & v_nid & """ DEVID=""" & v_did & """"
        nr = CLDS_Query(ed, 1, "DW", "NN", id, cc, ccc)
        If nr <= 0 Then
            MsgBox("Near-node details not found")
            Exit Sub
        End If
        Dim lvi As New System.Windows.Forms.ListViewItem
        lvi.Group = lv.Groups("New")
        lvi.Text = cc(ccc("NN_ID"), 1)
        lvi.SubItems.Add(cc(ccc("NN_AREA"), 1))
        lvi.SubItems.Add(cc(ccc("NN_VECTOR"), 1))
        lvi.SubItems.Add(cc(ccc("NN_DEFAULT"), 1))
        lvi.SubItems.Add(cc(ccc("NN_USED"), 1))
        lvi.SubItems.Add(cc(ccc("NN_VECTOR"), 1))
        lvi.SubItems.Add(cc(ccc("NN_DELTA"), 1))
        lv.Items.Add(lvi)
        For i As Integer = 0 To lv.Columns.Count - 1
            lv.Columns(i).Width = -2
        Next
        lv.Update()
        CLDS_ShowOffRoute(v_did, v_nid, 0, True)
    End Sub
    Public Sub CLDS_SaveNearNodes(ByVal p_dialog As CLDS_Network_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim a As String
        Dim id As String
        Dim did As String = p_dialog.tbDevID.Text
        Dim lv As ListView = p_dialog.lvNNodes
        For Each lvi As ListViewItem In lv.Items
            Select Case lvi.Group.Name
                Case "New"
                    a = "INSERT"
                Case "Updated"
                    a = "UPDATE"
                Case "Deleted"
                    a = "DELETE"
                Case Else
                    a = "-"
            End Select
            Dim nc As Integer = Val(lvi.SubItems(4).Text)
            If a <> "-" Then
                id = "ACTION=""" & a & """"
                id = id & " DEVID=""" & did & """"
                id = id & " NODEID=""" & lvi.Text & """"
                id = id & " OFFRL=""" & lvi.SubItems(2).Text & """"
                id = id & " DFLT=""" & lvi.SubItems(3).Text & """"
                Dim nr As Integer
                Dim cc(,) As String
                Dim ccc As Collection = Nothing
                nr = CLDS_Query(ed, 1, a, "NN", id, cc, ccc)
                If nr <= 0 Then
                    MsgBox("Problem updating near-node in CMPIC database")
                    Exit Sub
                End If
            End If
        Next
        CLDS_DeviceDetail(p_dialog, did)
    End Sub
    Public Sub CLDS_GetAssocAreas(ByVal p_context As String, ByVal p_lv As ListView)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        p_lv.Clear()
        p_lv.Columns.Add("Code")
        p_lv.Columns.Add("Description")
        Dim nr As Integer
        Dim cc(,) As String
        Dim ccc As Collection = Nothing
        Dim id As String = Microsoft.VisualBasic.FileIO.FileSystem.GetName(Application.DocumentManager.MdiActiveDocument.Name)
        id = UCase(Mid$(id, 1, InStr(id, ".") - 1))
        id = "ID=""" & id & """"
        nr = CLDS_Query(ed, 1, p_context, "AA", id, cc, ccc)
        If nr <= 0 Then
            Dim lvi As New System.Windows.Forms.ListViewItem
            lvi.Text = "%"
            lvi.SubItems.Add("All areas")
            p_lv.Items.Add(lvi)
        Else
            For i As Integer = 1 To nr - 1
                Dim lvi As New System.Windows.Forms.ListViewItem
                lvi.Text = cc(ccc("AA_ID"), i)
                lvi.SubItems.Add(cc(ccc("AA_DESC"), i))
                p_lv.Items.Add(lvi)
            Next
        End If
        For i As Integer = 0 To p_lv.Columns.Count - 1
            p_lv.Columns(i).Width = -2
        Next
        p_lv.Update()
    End Sub
#End Region
#Region "Routing rules"
    Public Sub CLDS_AddReqdRule(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim s1Obj As ObjectId = ObjectId.Null
        Dim s2Obj As ObjectId = ObjectId.Null
        Dim nObj As ObjectId = ObjectId.Null
        Dim sObj As ObjectId = ObjectId.Null
        Dim rt As String = ""
        Dim rv As String = ""
        Dim rs As Integer = 0
        Dim rd As String = ""
        Dim o_fnode As String = ""
        Dim o_tnode As String = ""
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim obj() As ObjectId = psr.Value.GetObjectIds
                If obj.GetLength(0) = 1 Then
                    s1Obj = obj(0)
                ElseIf obj.GetLength(0) = 2 Then
                    s1Obj = obj(0)
                    s2Obj = obj(1)
                Else
                    ed.WriteMessage(vbLf & "Too many entities selected")
                End If
                Dim xobj() As ObjectId
                ed.SetImpliedSelection(xobj)
            End If
        Catch ex As Exception

        End Try
        If s1Obj.IsNull And s2Obj.IsNull Then
            ed.WriteMessage(vbLf & "Node, or Node+Segment, must be selected for a new ""required"" rule" & vbLf)
            Exit Sub
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                If s2Obj.IsNull Then
                    Dim nBlock As BlockReference = CLDS_IsNode(nTrans, s1Obj)
                    If nBlock Is Nothing Then
                        ed.WriteMessage(vbLf & "Node must be selected for a new ""required node"" rule" & vbLf)
                        Exit Sub
                    End If
                    rt = "RN"
                    rv = CLDS_GetBlockAttr(nBlock, pPrefs.t_node)
                    rd = ""
                Else
                    Dim nBlock As BlockReference = CLDS_IsNode(nTrans, s1Obj)
                    Dim lineX As ResultBuffer = CLDS_IsSegment(nTrans, s2Obj)
                    Dim lineO As ObjectId = s2Obj
                    If nBlock Is Nothing Then
                        nBlock = CLDS_IsNode(nTrans, s2Obj)
                        lineX = CLDS_IsSegment(nTrans, s1Obj)
                        lineO = s1Obj
                    End If
                    If nBlock Is Nothing Or lineX Is Nothing Then
                        ed.WriteMessage(vbLf & "From/to Node+Segment must be selected for a new ""required segment"" rule" & vbLf)
                        Exit Sub
                    End If
                    rt = "RS"
                    Dim ra As TypedValue() = lineX.AsArray
                    o_fnode = ra(0).Value
                    o_tnode = ra(1).Value
                    Dim o_segid As String
                    If UBound(ra) >= 5 Then
                        o_segid = ra(5).Value
                    Else
                        o_segid = "-"
                    End If
                    rv = CLDS_GetBlockAttr(nBlock, pPrefs.t_node)
                    If rv = o_fnode Then
                        rv = o_fnode & ":" & o_tnode
                        rd = "F"
                    ElseIf rv = o_tnode Then
                        rv = o_tnode & ":" & o_fnode
                        rd = "T"
                    Else
                        ed.WriteMessage(vbLf & "From/to Node+Segment must be selected for a new ""required segment"" rule" & vbLf)
                        Exit Sub
                    End If
                    If o_segid <> "-" Then
                        rv = o_segid
                    End If
                End If
                nTrans.Commit()
            End Using
        End Using
        For Each xlvi As ListViewItem In p_dialog.lvCRules.Items
            Dim xrt As String = xlvi.Text
            If xrt = "RS" Or xrt = "NS" Or xrt = "RN" Then
                rs = rs + 1
            End If
        Next
        rs = rs + 1
        Dim lvi As New ListViewItem
        lvi.Text = rt
        lvi.SubItems.Add(rv)
        lvi.SubItems.Add(rs)
        lvi.SubItems.Add(rd)
        lvi.SubItems.Add("Y")
        lvi.SubItems.Add(o_fnode)
        lvi.SubItems.Add(o_tnode)
        lvi.Group = p_dialog.lvCRules.Groups("New")
        p_dialog.lvCRules.Items.Add(lvi)
        p_dialog.lvCRules.Update()
        If rt = "RN" Then
            CLDS_HiliteNode(rv, rt)
        Else
            CLDS_HiliteNode(o_fnode, rt)
            CLDS_HiliteNode(o_tnode, rt)
            CLDS_HiliteSegment(o_fnode, o_tnode, rt)
        End If
    End Sub
    Public Sub CLDS_AddBarredRule(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim s1Obj As ObjectId = ObjectId.Null
        Dim nObj As ObjectId = ObjectId.Null
        Dim sObj As ObjectId = ObjectId.Null
        Dim rt As String = ""
        Dim rv As String = ""
        Dim rs As String = ""
        Dim rd As String = ""
        Dim o_fnode As String = ""
        Dim o_tnode As String = ""
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim obj() As ObjectId = psr.Value.GetObjectIds
                If obj.GetLength(0) = 1 Then
                    s1Obj = obj(0)
                Else
                    ed.WriteMessage(vbLf & "Too many entities selected")
                End If
                Dim xobj() As ObjectId
                ed.SetImpliedSelection(xobj)
            End If
        Catch ex As Exception

        End Try
        If s1Obj.IsNull Then
            ed.WriteMessage(vbLf & "Node or Segment must be selected for a new ""prohibited"" rule" & vbLf)
            Exit Sub
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nBlock As BlockReference = CLDS_IsNode(nTrans, s1Obj)
                Dim lineX As ResultBuffer = CLDS_IsSegment(nTrans, s1Obj)
                Dim lineO As ObjectId = s1Obj
                If nBlock Is Nothing And lineX Is Nothing Then
                    ed.WriteMessage(vbLf & "Node or Segment must be selected for a new ""prohibited segment"" rule" & vbLf)
                    Exit Sub
                End If
                If nBlock Is Nothing Then
                    rt = "PS"
                    Dim ra As TypedValue() = lineX.AsArray
                    o_fnode = ra(0).Value
                    o_tnode = ra(1).Value
                    Dim o_segid As String
                    If UBound(ra) >= 5 Then
                        o_segid = ra(5).Value
                    Else
                        o_segid = "-"
                    End If
                    rv = o_fnode & ":" & o_tnode
                    If o_segid <> "-" Then
                        rv = o_segid
                    End If
                    rd = ""
                Else
                    rt = "PN"
                    rv = CLDS_GetBlockAttr(nBlock, pPrefs.t_node)
                    rd = ""
                End If
                nTrans.Commit()
            End Using
        End Using
        Dim lvi As New ListViewItem
        lvi.Text = rt
        lvi.SubItems.Add(rv)
        lvi.SubItems.Add(rs)
        lvi.SubItems.Add(rd)
        lvi.SubItems.Add("Y")
        lvi.SubItems.Add(o_fnode)
        lvi.SubItems.Add(o_tnode)
        lvi.Group = p_dialog.lvCRules.Groups("New")
        p_dialog.lvCRules.Items.Add(lvi)
        p_dialog.lvCRules.Update()
        If rt = "PN" Then
            CLDS_HiliteNode(rv, rt)
        Else
            CLDS_HiliteSegment(o_fnode, o_tnode, rt)
        End If
    End Sub
    Public Sub CLDS_DeleteCRule(ByVal p_dialog As CLDS_Route_Container)
        Dim lvi As ListViewItem = Nothing
        Dim nn As String = ""
        Dim nu As Integer = 0
        If p_dialog.lvCRules.SelectedItems.Count = 1 Then
            lvi = p_dialog.lvCRules.SelectedItems.Item(0)
            nn = lvi.Text
        End If
        If nn = "" Then
            MsgBox("No rule selected")
        Else
            If lvi.Group.Name = "Deleted" Then
                lvi.Group = lvi.ListView.Groups("Updated")
            ElseIf lvi.Group.Name = "New" Then
                lvi.Remove()
            Else
                lvi.Group = lvi.ListView.Groups("Deleted")
            End If
            lvi.Selected = True
        End If
    End Sub
    Public Sub CLDS_UpdateCRule(ByVal p_dialog As CLDS_Route_Container, ByVal p_ud As String)
        Dim lvi As ListViewItem = Nothing
        Dim nn As String = ""
        Dim nu As Integer = 0
        If p_dialog.lvCRules.SelectedItems.Count = 1 Then
            lvi = p_dialog.lvCRules.SelectedItems.Item(0)
            nn = lvi.Text
        End If
        If nn = "" Then
            MsgBox("No rule selected", MsgBoxStyle.Exclamation, "CMPIC Cable Rule")
            Exit Sub
        End If
        If Not (nn = "RN" Or nn = "RS" Or nn = "NS") Then
            MsgBox("Priority not relevant to this rule type", MsgBoxStyle.Exclamation, "CMPIC Cable Rule")
            Exit Sub
        End If
        If lvi.Group.Name = "Deleted" Then
            MsgBox("Please undelete rule before changing priority", MsgBoxStyle.Exclamation, "CMPIC Cable Rule")
            Exit Sub
        End If
        Dim ns As Integer = Val(lvi.SubItems.Item(2).Text)
        Dim rs As Integer = 0, xs As Integer = 0
        For Each xlvi As ListViewItem In p_dialog.lvCRules.Items
            If xlvi.Group.Name = "Deleted" Then
                MsgBox("Please save any pending deletions before changing priority", MsgBoxStyle.Exclamation, "CMPIC Cable Rule")
                Exit Sub
            End If
            Dim xrt As String = xlvi.Text
            If xrt = "RS" Or xrt = "NS" Or xrt = "RN" Then
                rs = rs + 1
            End If
        Next
        If p_ud = "UP" Then
            xs = ns
            ns = ns - 1
        Else
            xs = ns
            ns = ns + 1
        End If
        If ns = 0 Then
            MsgBox("Rule already has first priority", MsgBoxStyle.Exclamation, "CMPIC Cable Rule")
            Exit Sub
        End If
        If ns > rs Then
            MsgBox("Rule already has last priority", MsgBoxStyle.Exclamation, "CMPIC Cable Rule")
            Exit Sub
        End If
        For Each xlvi As ListViewItem In p_dialog.lvCRules.Items
            Dim xrt As String = xlvi.Text
            If xrt = "RS" Or xrt = "NS" Or xrt = "RN" Then
                Dim s As Integer = Val(xlvi.SubItems.Item(2).Text)
                If s = ns Then
                    xlvi.SubItems.Item(2).Text = xs
                    If xlvi.Group.Name <> "New" Then
                        xlvi.Group = xlvi.ListView.Groups("Updated")
                    End If
                ElseIf s = xs Then
                    xlvi.SubItems.Item(2).Text = ns
                    If xlvi.Group.Name <> "New" Then
                        xlvi.Group = xlvi.ListView.Groups("Updated")
                    End If
                End If
            End If
        Next
        lvi.Selected = True
        p_dialog.lvCRules.Update()
    End Sub
    Public Sub CLDS_SaveCRules(ByVal p_dialog As CLDS_Route_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim a As String
        Dim id As String
        Dim did As String = p_dialog.tbCabID.Text
        Dim lv As ListView = p_dialog.lvCRules
        For Each lvi As ListViewItem In lv.Items
            Select Case lvi.Group.Name
                Case "New"
                    a = "INSERT"
                Case "Updated"
                    a = "UPDATE"
                Case "Deleted"
                    a = "DELETE"
                Case Else
                    a = "-"
            End Select
            If a <> "-" Then
                id = "ACTION=""" & a & """"
                id = id & " CABID=""" & did & """"
                id = id & " TYPE=""" & lvi.Text & """"
                id = id & " VALUE=""" & lvi.SubItems(1).Text & """"
                If lvi.SubItems(2).Text <> "" Then
                    id = id & " PRIORITY=""" & lvi.SubItems(2).Text & """"
                End If
                If lvi.SubItems(3).Text <> "" Then
                    id = id & " DIRECTION=""" & lvi.SubItems(3).Text & """"
                End If
                Dim nr As Integer
                Dim cc(,) As String
                Dim ccc As Collection = Nothing
                nr = CLDS_Query(ed, 1, a, "RR", id, cc, ccc)
                If nr <= 0 Then
                    MsgBox("Problem updating cable rule in CMPIC database")
                    Exit Sub
                End If
            End If
        Next
        CLDS_ClearHighlights()
        CLDS_CRuleDetail(p_dialog, did)
    End Sub

#End Region
#Region "Cable functions"
    Public Sub CLDS_SetComboBox(ByVal p_combo As ComboBox, ByVal p_value As String, ByVal p_context As String, Optional ByVal p_require As String = "", Optional ByVal p_col As String = "CODE", Optional ByVal p_id As String = "%")
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim id As String = p_id
        p_combo.Items.Clear()
        For j As Integer = 1 To 1000
            Dim aarr As String(,)
            Dim acc As Collection
            Dim req As String
            If j = 1 Then
                req = p_require
                If req = "" Then
                    req = p_context
                End If
            Else
                req = "-"
            End If
            Dim z As Integer = CLDS_Query(ed, 1, p_context, req, id, aarr, acc)
            If z > 0 Then
                For i As Integer = 1 To z - 1
                    p_combo.Items.Add(aarr(acc(p_require & "_" & p_col), i))
                Next
            Else
                Exit For
            End If
        Next
        p_combo.Text = p_value
    End Sub
    Public Function CLDS_SaveCable(ByVal p_dialog As CLDS_Route_Container) As Boolean
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim a As String
        Dim id As String
        Dim did As String = p_dialog.tbCabID.Text
        Dim lv As ListView = p_dialog.lvCRules
        Dim fn As String = p_dialog.cbFNode.Text
        Dim tn As String = p_dialog.cbTNode.Text
        If fn <> "*" And fn <> "OFF ROUTE" Then
            If p_dialog.tbFOffL.Text <> "" Then
                fn = fn & ":" & p_dialog.tbFOffL.Text
            End If
        End If
        If tn <> "*" And tn <> "OFF ROUTE" Then
            If p_dialog.tbTOffL.Text <> "" Then
                tn = tn & ":" & p_dialog.tbTOffL.Text
            End If
        End If
        a = "UPDATE"
        id = "ACTION=""" & a & """"
        id = id & " CABID=""" & did & """"
        If p_dialog.cbFNode.Text <> p_dialog.tbFromNode.Text Or _
        p_dialog.cbTNode.Text <> p_dialog.tbToNode.Text Or _
        p_dialog.ptbFOffL <> p_dialog.tbFOffL.Text Or _
        p_dialog.ptbTOffL <> p_dialog.tbTOffL.Text Then
            id = id & " FNODE=""" & fn & """"
            id = id & " TNODE=""" & tn & """"
        End If
        If p_dialog.cbCType.Text <> p_dialog.tbType.Text Then
            id = id & " CTYPE=""" & p_dialog.cbCType.Text & """"
        End If
        If p_dialog.cbCSeg.Text <> p_dialog.tbSeg.Text Then
            id = id & " CSEG=""" & p_dialog.cbCSeg.Text & """"
        End If
        Dim nr As Integer
        Dim cc(,) As String
        Dim ccc As Collection = Nothing
        nr = CLDS_Query(ed, 1, a, "CN", id, cc, ccc)
        If nr <= 0 Then
            MsgBox("Problem updating cable in CMPIC database" & Chr(10) & CLDS_Static_Utils.CLDS_ExtractError(pCMERR))
            Return False
            Exit Function
        End If
        Return True
    End Function
    Public Sub CLDS_ShowMultiCables(ByVal p_dialog As CLDS_Multirow_Container, ByVal ctx As String, ByVal nr As Integer, ByVal cc As String(,), ByVal ccc As Collection)
        p_dialog.tpMultiRow.SelectTab("tpMCables")
        p_dialog.lvMultiCable.Clear()
        p_dialog.lvMultiCable.Columns.Add("Cable ID")
        p_dialog.lvMultiCable.Columns.Add(CMAPI.CMUnitdesc)
        p_dialog.lvMultiCable.Columns.Add("From")
        p_dialog.lvMultiCable.Columns.Add("To")
        p_dialog.lvMultiCable.Columns.Add(tokens("PD_SYSNAME"))
        p_dialog.lvMultiCable.Columns.Add(tokens("PD_SGNAME"))
        p_dialog.lvMultiCable.Columns.Add(tokens("PD_CTNAME"))
        p_dialog.lvMultiCable.Columns.Add("Status")
        p_dialog.lvMultiCable.Columns.Add("Request")
        For i As Integer = 1 To nr - 1
            Dim lvi As New System.Windows.Forms.ListViewItem
            lvi.Text = cc(ccc(ctx + "_ID"), i)
            lvi.SubItems.Add(cc(ccc(ctx + "_VESSEL"), i))
            Dim f As String = cc(ccc(ctx + "_FROMDEVICE"), i)
            If cc(ccc(ctx + "_FROMNODE"), i) <> "" Then
                f = f & "@" & cc(ccc(ctx + "_FROMNODE"), i)
                If cc(ccc(ctx + "_FROMOFFL"), i) <> "" And Val(cc(ccc(ctx + "_FROMOFFL"), i)) > 0 Then
                    f = f & "[" & cc(ccc(ctx + "_FROMOFFL"), i) & tokens("PD_LENUOM") & "]"
                End If
            End If
            lvi.SubItems.Add(f)
            Dim t As String = cc(ccc(ctx + "_TODEVICE"), i)
            If cc(ccc(ctx + "_TONODE"), i) <> "" Then
                t = t & "@" & cc(ccc(ctx + "_TONODE"), i)
                If cc(ccc(ctx + "_TOOFFL"), i) <> "" And Val(cc(ccc(ctx + "_TOOFFL"), i)) > 0 Then
                    t = t & "[" & cc(ccc(ctx + "_TOOFFL"), i) & tokens("PD_LENUOM") & "]"
                End If
            End If
            lvi.SubItems.Add(t)
            lvi.SubItems.Add(cc(ccc(ctx + "_SYSTEM"), i))
            lvi.SubItems.Add(cc(ccc(ctx + "_SEGREGATION"), i))
            lvi.SubItems.Add(cc(ccc(ctx + "_NSN"), i))
            lvi.SubItems.Add(cc(ccc(ctx + "_ROUTESTATUS"), i))
            lvi.SubItems.Add(cc(ccc(ctx + "_ARINO"), i))
            p_dialog.lvMultiCable.Items.Add(lvi)
        Next
        For i As Integer = 0 To p_dialog.lvMultiCable.Columns.Count - 1
            p_dialog.lvMultiCable.Columns(i).Width = -2
        Next
        If CMAPI.CMUnits = 1 Then
            p_dialog.lvMultiCable.Columns(1).Width = 0
        End If
        p_dialog.lvMultiCable.Update()

    End Sub
#End Region
#Region "Current route functions"
    Public Sub CLDS_RouteCableDetail(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, Optional ByVal p_vessel As Integer = 0)
        Dim doc As Document
        Dim ed As Editor
        Dim v_vessel As Integer
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        p_dialog.tbCabID.Text = p_cabid
        p_dialog.tbFromDev.Text = ""
        p_dialog.tbFromNode.Text = ""
        p_dialog.tbFOffL.Text = ""
        p_dialog.ptbFOffL = ""
        p_dialog.tbToDev.Text = ""
        p_dialog.tbToNode.Text = ""
        p_dialog.tbTOffL.Text = ""
        p_dialog.ptbTOffL = ""
        p_dialog.tbSeg.Text = ""
        p_dialog.tbType.Text = ""
        p_dialog.tbNStatus.Text = ""
        p_dialog.tbStatus.Text = ""
        p_dialog.tbStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Regular)
        p_dialog.btCabEdit.Enabled = False
        p_dialog.btCabSave.Enabled = False
        p_dialog.tbCRLength.Text = ""
        p_dialog.btCRReverse.Enabled = False
        p_dialog.btCRShow.Enabled = False
        p_dialog.btCRClear.Enabled = False
        p_dialog.btCRDelete.Enabled = False
        p_dialog.tbARNo.Text = ""
        p_dialog.tbARFnode.Text = ""
        p_dialog.tbARTNode.Text = ""
        p_dialog.tbARStatus.Text = ""
        p_dialog.tbARLog.Text = ""
        p_dialog.tbARLog.Visible = False
        p_dialog.btARShow.Enabled = False
        p_dialog.btARSubmit.Enabled = False
        p_dialog.cbARApprove.Enabled = False
        p_dialog.btARAccept.Enabled = False
        p_dialog.btARReject.Enabled = False
        p_dialog.gbARScope.Enabled = False
        p_dialog.lvCRSegments.Clear()
        p_dialog.lvARSegments.Clear()
        p_dialog.tbMRStart.Text = ""
        p_dialog.tbMRStart.ReadOnly = True
        p_dialog.btMRStart.Enabled = False
        p_dialog.btMRGoNext.Enabled = False
        p_dialog.tbMRLength.Text = ""
        p_dialog.lvMRNext.Clear()
        p_dialog.pcbFNode.Hide()
        p_dialog.pcbTNode.Hide()
        p_dialog.pcbCType.Hide()
        p_dialog.pcbCSeg.Hide()
        p_dialog.tbFOffL.ReadOnly = True
        p_dialog.tbTOffL.ReadOnly = True

        CLDS_ClearHighlights()

        If p_cabid = "" Then
            If Not p_mcbdialog Is Nothing Then
                p_mcbdialog.lvMultiCable.Clear()
                pHzPalette.Visible = False
            End If
            p_dialog.tcRoute.Hide()
            Exit Sub
        End If

        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer
        Dim rqr As String
        If InStr(p_cabid, "=""") > 0 Then
            rqr = "QBE"
        Else
            rqr = "CB"
        End If
        v_vessel = p_vessel
        nr = CLDS_Query(ed, 1, "CB", rqr, p_cabid, sc, scc, v_vessel)
        If nr <= 0 Then
            If rqr = "QBE" Then
                p_dialog.tbStatus.Text = "No matching cable found"
            Else
                p_dialog.tbStatus.Text = "ERROR: cable not found"
            End If
            p_dialog.tbStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Bold)
            Exit Sub
        End If
        If nr > 2 Then
            CLDS_CMPICHzPalette()
            CLDS_ShowMultiCables(p_mcbdialog, rqr, nr, sc, scc)
            p_hzpalette.Visible = True
        End If
        p_dialog.Vessel = Val(sc(scc(rqr + "_VESSEL"), 1))
        p_dialog.tbCabID.Text = sc(scc(rqr + "_ID"), 1)
        p_dialog.tbFromDev.Text = sc(scc(rqr + "_FROMDEVICE"), 1)
        p_dialog.tbFromNode.Text = sc(scc(rqr + "_FROMNODE"), 1)
        p_dialog.tbFOffL.Text = sc(scc(rqr + "_FROMOFFL"), 1)
        p_dialog.ptbFOffL = p_dialog.tbFOffL.Text
        p_dialog.tbToDev.Text = sc(scc(rqr + "_TODEVICE"), 1)
        p_dialog.tbToNode.Text = sc(scc(rqr + "_TONODE"), 1)
        p_dialog.tbTOffL.Text = sc(scc(rqr + "_TOOFFL"), 1)
        p_dialog.ptbTOffL = p_dialog.tbTOffL.Text
        p_dialog.tbSeg.Text = sc(scc(rqr + "_SEGREGATION"), 1)
        p_dialog.tbType.Text = sc(scc(rqr + "_NSN"), 1)
        p_dialog.tbNStatus.Text = sc(scc(rqr + "_NROUTESTATUS"), 1)
        p_dialog.tbStatus.Text = sc(scc(rqr + "_ROUTESTATUS"), 1)
        Dim reversed As String = sc(scc(rqr + "_REVERSED"), 1)
        If reversed = "Y" Then
            p_dialog.tbStatus.Text = p_dialog.tbStatus.Text & " [reversed]"
        End If
        p_dialog.tbCRLength.Text = sc(scc(rqr + "_DLENGTH"), 1)
        p_dialog.tbMRLength.Text = p_dialog.tbCRLength.Text
        p_dialog.tbARStatus.Font = New System.Drawing.Font(p_dialog.tbARStatus.Font, System.Drawing.FontStyle.Regular)
        p_dialog.lbSeg.Text = tokens("PD_SGNAME")
        p_dialog.lbType.Text = tokens("PD_CTNAME")
        p_dialog.lbCRLength.Text = "Length [" + tokens("PD_LENUOM") + "]"
        p_dialog.lbARLength.Text = "Length [" + tokens("PD_LENUOM") + "]"
        p_dialog.lbMRLength.Text = "Length [" + tokens("PD_LENUOM") + "]"
        p_dialog.ShowVessel()
        If sc(scc(rqr + "_FROMNODE"), 1) = "OFF ROUTE" Then   ' Off-route cable: route change and autoroute not permitted
            If p_dialog.tcRoute.Visible Then
                p_dialog.tcRoute.Hide()
            End If
            Exit Sub
        End If
        If Not p_dialog.tcRoute.Visible Then
            p_dialog.tcRoute.Show()
        End If
        If Val(p_dialog.tbNStatus.Text) > 0 Then            ' Routed cable: enable show/clear
            p_dialog.btCRShow.Enabled = True
            p_dialog.btCRClear.Enabled = True
        End If
        If Val(p_dialog.tbNStatus.Text) >= R_DRCA Then          ' Approved cable: delete and autoroute not permitted
            Exit Sub
        End If
        p_dialog.btCRReverse.Enabled = True
        If Val(p_dialog.tbNStatus.Text) > 0 Then            ' Routed cable: enable delete
            p_dialog.btCRDelete.Enabled = True
        Else
            p_dialog.btCabEdit.Enabled = True
        End If
        CLDS_RoutePrefs(p_dialog, p_dialog.tbCabID.Text, p_dialog.Vessel)
        CLDS_ARouteDetail(p_dialog, p_dialog.tbCabID.Text, p_dialog.Vessel)
        CLDS_CRuleDetail(p_dialog, p_dialog.tbCabID.Text, p_dialog.Vessel)
        If Val(p_dialog.tbNStatus.Text) < R_DRCNA Then          ' No route or incomplete route, manual routing enabled
            p_dialog.btMRStart.Enabled = True
        End If
    End Sub
    Public Sub CLDS_ClearHighlights()
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim hpsr As PromptSelectionResult = CLDS_SelectHighlights(ed)
        If hpsr.Value Is Nothing Then
            Exit Sub
        End If
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                For Each oID As ObjectId In hpsr.Value.GetObjectIds
                    Dim entE As Entity = DirectCast(oID.GetObject(OpenMode.ForWrite), Entity)
                    entE.Erase()
                    erased.Add(oID)
                Next
                dTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_CRuleDetail(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, Optional ByVal p_vessel As Integer = 0)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim lvgExisting As New ListViewGroup("Existing", "Existing"), lvgNew As New ListViewGroup("New", "New"), lvgUpdated As New ListViewGroup("Updated", "Updated"), lvgDeleted As New ListViewGroup("Deleted", "Deleted")
        p_dialog.lvCRules.Groups.Add(lvgExisting)
        p_dialog.lvCRules.Groups.Add(lvgNew)
        p_dialog.lvCRules.Groups.Add(lvgUpdated)
        p_dialog.lvCRules.Groups.Add(lvgDeleted)
        p_dialog.lvCRules.Clear()
        p_dialog.lvCRules.Columns.Add("Type")
        p_dialog.lvCRules.Columns.Add("Value")
        p_dialog.lvCRules.Columns.Add("Priority")
        p_dialog.lvCRules.Columns.Add("Direction")
        p_dialog.lvCRules.Columns.Add("Enabled")
        p_dialog.lvCRules.Columns.Add("From")
        p_dialog.lvCRules.Columns.Add("To")
        Dim cc(,) As String
        Dim ccc As Collection = Nothing
        Dim id As String = p_cabid
        Dim nr As Integer = CLDS_Query(ed, 1, "CB", "RR", id, cc, ccc, p_vessel)
        If nr <= 0 Then
            p_dialog.lbRLStatus.Text = "No routing rules"
            p_dialog.lbRLStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Bold)
            CLDS_HiliteNode(p_dialog.tbFromDev.Text, "FD")
            CLDS_HiliteNode(p_dialog.tbFromNode.Text, "RN")
            CLDS_HiliteNode(p_dialog.tbToDev.Text, "TD")
            CLDS_HiliteNode(p_dialog.tbToNode.Text, "RN")
            Application.UpdateScreen()
            Exit Sub
        Else
            p_dialog.lbRLStatus.Text = ""
            p_dialog.lbRLStatus.Font = New System.Drawing.Font(p_dialog.tbStatus.Font, System.Drawing.FontStyle.Regular)
        End If
        For i As Integer = 1 To nr - 1
            Dim lvi As New System.Windows.Forms.ListViewItem
            lvi.Group = lvgExisting
            Dim rt As String = cc(ccc("RR_RULE"), i)
            Dim rn As String = cc(ccc("RR_ID2"), i)
            Dim fn As String = cc(ccc("RR_FROMID"), i)
            Dim tn As String = cc(ccc("RR_TOID"), i)
            lvi.Text = rt
            lvi.SubItems.Add(rn)
            lvi.SubItems.Add(cc(ccc("RR_PRIORITY"), i))
            lvi.SubItems.Add(cc(ccc("RR_DIRECTION"), i))
            lvi.SubItems.Add(cc(ccc("RR_ENABLED"), i))
            lvi.SubItems.Add(fn)
            lvi.SubItems.Add(tn)
            p_dialog.lvCRules.Items.Add(lvi)
            If rt = "RN" Or rt = "PN" Then
                CLDS_HiliteNode(rn, rt)
            ElseIf rt = "RS" Or rt = "NS" Then
                CLDS_HiliteNode(fn, rt)
                CLDS_HiliteNode(tn, rt)
                CLDS_HiliteSegment(fn, tn, rt)
            ElseIf rt = "PS" Then
                CLDS_HiliteSegment(fn, tn, rt)
            End If
        Next
        For i As Integer = 0 To p_dialog.lvCRules.Columns.Count - 1
            p_dialog.lvCRules.Columns(i).Width = -2
        Next
        p_dialog.lvCRules.Update()
        CLDS_HiliteNode(p_dialog.tbFromDev.Text, "FD")
        CLDS_HiliteNode(p_dialog.tbFromNode.Text, "RN")
        CLDS_HiliteNode(p_dialog.tbToDev.Text, "TD")
        CLDS_HiliteNode(p_dialog.tbToNode.Text, "RN")
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_RouteClear(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim rl As String = pPrefs.l_crte & "_" & p_cabid
        Dim al As String = pPrefs.l_arte & "_" & p_cabid
        'Dim ltvs() As TypedValue = New TypedValue() _
        '{New TypedValue(DxfCode.Operator, "<or"), New TypedValue(DxfCode.LayerName, rl), New TypedValue(DxfCode.LayerName, al), New TypedValue(DxfCode.Operator, "or>")}
        Dim ltv As System.Collections.Generic.List(Of TypedValue) = New System.Collections.Generic.List(Of TypedValue)
        ltv.Add(New TypedValue(DxfCode.Operator, "<or"))
        ltv.Add(New TypedValue(DxfCode.LayerName, rl))
        ltv.Add(New TypedValue(DxfCode.LayerName, al))
        For i As Integer = 1 To 20
            Dim ml As String = pPrefs.l_arte & "{" & Trim(Str$(i)) & "}" & "_" & p_cabid
            ltv.Add(New TypedValue(DxfCode.LayerName, ml))
        Next
        ltv.Add(New TypedValue(DxfCode.Operator, "or>"))
        Dim ltvs() As TypedValue = ltv.ToArray
        Dim lsf As SelectionFilter = New SelectionFilter(ltvs)
        Dim lpsr As PromptSelectionResult = ed.SelectAll(lsf)
        If lpsr.Value Is Nothing Then
            Exit Sub
        End If
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                For Each lineID As ObjectId In lpsr.Value.GetObjectIds
                    Dim lineE As Entity = DirectCast(lineID.GetObject(OpenMode.ForWrite), Entity)
                    lineE.Erase()
                    erased.Add(lineID)
                Next
                CLDS_DeleteLayer(dTrans, doc, rl)
                CLDS_DeleteLayer(dTrans, doc, al)
                dTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_RouteClearAll(ByVal p_dialog As CLDS_Route_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim lc As New Collection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using lTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim lt As LayerTable = DirectCast(lTrans.GetObject(doc.Database.LayerTableId, OpenMode.ForRead), LayerTable)
                For Each ltrO As ObjectId In lt
                    If ltrO.IsValid And Not (ltrO.IsNull Or ltrO.IsErased Or ltrO.IsEffectivelyErased) Then
                        Dim ltr As LayerTableRecord = DirectCast(lTrans.GetObject(ltrO, OpenMode.ForRead), LayerTableRecord)
                        If Mid$(ltr.Name, 1, Len(pPrefs.l_crte) + 1) = pPrefs.l_crte & "_" Then
                            lc.Add(Mid$(ltr.Name, Len(pPrefs.l_crte) + 2), ltr.Name)
                        End If
                        If Mid$(ltr.Name, 1, Len(pPrefs.l_arte) + 1) = pPrefs.l_arte & "_" Then
                            lc.Add(Mid$(ltr.Name, Len(pPrefs.l_arte) + 2), ltr.Name)
                        End If
                    End If
                Next
                lTrans.Commit()
            End Using
        End Using
        For Each cabid As String In lc
            CLDS_RouteClear(p_dialog, cabid)
        Next
    End Sub
    Public Sub CLDS_DeleteCR(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, ByVal p_lvsegs As ListView)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_cabid = "" Then
            Exit Sub
        End If
        Dim id As String = "CABID=""" & p_cabid & """"
        id = id & " FOCUS=""" & v_props.v_focus & """"
        If p_lvsegs.CheckedItems.Count > 0 Then
            For i As Integer = 0 To p_lvsegs.CheckedItems.Count - 1
                Dim lvi As ListViewItem = p_lvsegs.CheckedItems(i)
                Dim fn As String = lvi.SubItems.Item(2).Text
                Dim tn As String = lvi.SubItems.Item(3).Text
                Dim sid As String = id & " FNODE=""" & fn & """ TNODE=""" & tn & """"
                Dim sc(,) As String
                Dim scc As Collection = Nothing
                Dim nr As Integer = CLDS_Query(ed, 1, "DELETE", "CR", sid, sc, scc)
                If nr <= 0 Then
                    Exit Sub
                End If
            Next
            CLDS_RouteClear(p_dialog, p_cabid)
            CLDS_RouteCableDetail(p_dialog, p_cabid)
            Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromRgb(p_dialog.CRColour.R, p_dialog.CRColour.G, p_dialog.CRColour.B)
            CLDS_RouteHilite(p_dialog, p_cabid, c, p_dialog.lvCRSegments)
        Else
            Dim sc(,) As String
            Dim scc As Collection = Nothing
            Dim nr As Integer = CLDS_Query(ed, 1, "DELETE", "CR", id, sc, scc)
            If nr <= 0 Then
                Exit Sub
            End If
            CLDS_RouteClear(p_dialog, p_cabid)
            CLDS_RouteCableDetail(p_dialog, p_cabid)
        End If
    End Sub
    Public Sub CLDS_DeleteMultiCR(ByVal p_dialog As CLDS_Multirow_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        For Each lvi As ListViewItem In p_dialog.lvMultiCable.Items
            If lvi.Checked Then
                Dim p_cabid As String = lvi.SubItems(0).Text
                Dim id As String = "CABID=""" & p_cabid & """"
                id = id & " FOCUS=""" & v_props.v_focus & """"
                Dim sc(,) As String
                Dim scc As Collection = Nothing
                Dim nr As Integer = CLDS_Query(ed, 1, "DELETE", "CR", id, sc, scc)
                If nr <= 0 Then
                    Continue For
                Else
                    lvi.Remove()
                End If
            End If
        Next
        If p_dialog.lvMultiCable.Items.Count = 0 Then
            pMultiCabDialog.mrToolStripButton1.Enabled = False
            pMultiCabDialog.mrToolStripButton1.ToolTipText = ""
            pMultiCabDialog.A1 = ""
            pMultiCabDialog.mrToolStripButton2.Enabled = False
            pMultiCabDialog.mrToolStripButton2.ToolTipText = ""
            pMultiCabDialog.A2 = ""
            pMultiCabDialog.ToolStrip1.Update()
        End If
    End Sub
    Public Sub CLDS_RouteHilite(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, Optional ByVal p_colour As Color = Nothing, Optional ByVal p_lv As ListView = Nothing, Optional ByVal p_vessel As Integer = 0)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_cabid = "" Then
            Exit Sub
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        CLDS_RouteClear(p_dialog, p_cabid)
        If Not p_lv Is Nothing Then
            p_lv.Clear()
        End If
        Dim rl As String = CLDS_OKLayerName(pPrefs.l_crte & "_" & p_cabid)
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                'Dim hlc As ObjectIdCollection = New ObjectIdCollection
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                Dim bt As BlockTable = DirectCast(dTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(dTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                'Dim dot As DrawOrderTable = DirectCast(dTrans.GetObject(btr.DrawOrderTableId, OpenMode.ForWrite), DrawOrderTable)
                Dim h_sgmt As Boolean = False
                Dim v_vessel As Integer
                If p_vessel = 0 Then
                    v_vessel = Val(pProps.v_focus)
                Else
                    v_vessel = p_vessel
                End If
                Dim id As String = "CABLE=""" & p_cabid & """ FOCUS=""" & Trim(Str$(v_vessel)) & """"
                For i As Integer = 1 To 1000
                    Dim nr As Integer = CLDS_Query(ed, i, "CB", "ST", id, sc, scc)
                    If nr <= 0 Then
                        'If i = 1 Then
                        'ed.WriteMessage(vbLf & "No current route for cable " & p_cabid)
                        'End If
                        Exit For
                    End If
                    If i = 1 And Not p_lv Is Nothing Then
                        p_lv.Columns.Add("Sequence")
                        p_lv.Columns.Add("Seg ID")
                        p_lv.Columns.Add("From node")
                        p_lv.Columns.Add("To node")
                        p_lv.Columns.Add("Tier")
                        p_lv.Columns.Add("Type")
                        p_lv.Columns.Add("Length")
                        p_lv.Columns.Add("V.Fill")
                    End If
                    For r As Integer = 1 To nr - 1
                        Dim id1 As String = sc(scc("ST_FROMNODE"), r)
                        Dim id2 As String = sc(scc("ST_TONODE"), r)
                        If Not p_lv Is Nothing Then
                            Dim lvi As New System.Windows.Forms.ListViewItem
                            lvi.Text = sc(scc("ST_SEQNO"), r)
                            lvi.SubItems.Add(sc(scc("ST_ID"), r))
                            lvi.SubItems.Add(id1)
                            lvi.SubItems.Add(id2)
                            lvi.SubItems.Add(sc(scc("ST_TIERID"), r))
                            lvi.SubItems.Add(sc(scc("ST_NRTYPE"), r))
                            lvi.SubItems.Add(sc(scc("ST_LENGTH"), r))
                            lvi.SubItems.Add(sc(scc("ST_FILL"), r))
                            If Val(sc(scc("ST_FILL"), r)) > Val(sc(scc("ST_THRESHOLD"), r)) Then
                                lvi.ForeColor = Drawing.Color.White
                                lvi.BackColor = Drawing.Color.Crimson
                            ElseIf InStr(p_rtedialog.tbStatus.Text, "[reversed]") > 0 Then
                                lvi.BackColor = Drawing.Color.BlanchedAlmond
                            End If
                            p_lv.Items.Add(lvi)
                        End If
                        Dim nObj1 As ObjectId = CLDS_FindNode(dTrans, nd, id1)
                        Dim nObj2 As ObjectId = CLDS_FindNode(dTrans, nd, id2)
                        If Not (nObj1.IsNull Or nObj2.IsNull) Then
                            'Dim n1 As BlockReference = TryCast(nObj1.GetObject(OpenMode.ForRead), BlockReference)
                            'Dim n2 As BlockReference = TryCast(nObj2.GetObject(OpenMode.ForRead), BlockReference)
                            Dim n1 As BlockReference = TryCast(dTrans.GetObject(nObj1, OpenMode.ForRead, True), BlockReference)
                            Dim n2 As BlockReference = TryCast(dTrans.GetObject(nObj2, OpenMode.ForRead, True), BlockReference)
                            If Not (n1 Is Nothing Or n2 Is Nothing) Then
                                Dim nt As String = sc(scc("ST_NRTYPE"), r)
                                Dim ns As String = sc(scc("ST_SEGREGATION"), r)
                                Dim nl As String = sc(scc("ST_LENGTH"), r)
                                Dim si As String = sc(scc("ST_SEGMENTID"), r)
                                Dim ri As String = sc(scc("ST_RACEWAYID"), r)
                                If id1 <> id2 Then
                                    Dim sl As New Line(n1.Position, n2.Position)
                                    If Not h_sgmt Then
                                        Dim x_crte As Color
                                        If p_colour Is Nothing Then
                                            x_crte = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.c_crte)
                                        Else
                                            x_crte = p_colour
                                        End If
                                        CLDS_CheckLayer(dTrans, doc, rl, x_crte)
                                        h_sgmt = True
                                    End If
                                    CLDS_SetLayer(sl, rl, "Segment " & id1 & ":" & id2)
                                    ' sl.Layer = rl
                                    sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                                    btr.AppendEntity(sl)
                                    'hlc.Add(sl.ObjectId)
                                    dTrans.AddNewlyCreatedDBObject(sl, True)
                                    CLDS_SetLineXRec(dTrans, sl, id1, id2, nt, ns, nl, si, ri)
                                End If
                            End If
                        End If
                    Next
                    If Not p_lv Is Nothing Then
                        For r As Integer = 0 To p_lv.Columns.Count - 1
                            p_lv.Columns(r).Width = -2
                        Next
                        If tokens("PD_MULTITIER") <> "Y" Then
                            p_lv.Columns(4).Width = 0
                        End If
                        p_lv.Update()
                    End If
                Next
                'dot.MoveToTop(hlc)
                dTrans.Commit()
                Application.UpdateScreen()
            End Using
        End Using
        ' ed.Regen()
    End Sub
    Public Sub CLDS_RouteSegmentHilite(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, ByVal p_fnode As String, ByVal p_tnode As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_cabid = "" Then
            Exit Sub
        End If
        If p_fnode = p_tnode Then
            Exit Sub
        End If
        Dim rl As String = pPrefs.l_crte & "_" & p_cabid
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                Dim bt As BlockTable = DirectCast(dTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(dTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                Dim nObj1 As ObjectId = CLDS_FindNode(dTrans, nd, p_fnode)
                Dim nObj2 As ObjectId = CLDS_FindNode(dTrans, nd, p_tnode)
                If Not (nObj1.IsNull Or nObj2.IsNull) Then
                    Dim n1 As BlockReference = TryCast(nObj1.GetObject(OpenMode.ForRead), BlockReference)
                    Dim n2 As BlockReference = TryCast(nObj2.GetObject(OpenMode.ForRead), BlockReference)
                    If Not (n1 Is Nothing Or n2 Is Nothing) Then
                        Dim sl As New Line(n1.Position, n2.Position)
                        Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromRgb(p_dialog.CRColour.R, p_dialog.CRColour.G, p_dialog.CRColour.B)
                        CLDS_CheckLayer(dTrans, doc, rl, c)
                        CLDS_SetLayer(sl, rl, "Segment " & p_fnode & ":" & p_tnode)
                        'sl.Layer = rl
                        sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                        btr.AppendEntity(sl)
                        dTrans.AddNewlyCreatedDBObject(sl, True)
                        CLDS_SetLineXRec(dTrans, sl, p_fnode, p_tnode, "", "", "", "", "")
                    End If
                End If
                dTrans.Commit()
                Application.UpdateScreen()
            End Using
        End Using
    End Sub
    Public Sub CLDS_RouteSegmentUnHilite(ByVal p_cabid As String, ByVal p_fnode As String, ByVal p_tnode As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_cabid = "" Then
            Exit Sub
        End If
        If p_fnode = p_tnode Then
            Exit Sub
        End If
        Dim rl As String = pPrefs.l_crte & "_" & p_cabid
        Dim ltvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.LayerName, rl)}
        Dim lsf As SelectionFilter = New SelectionFilter(ltvs)
        Dim lpsr As PromptSelectionResult = ed.SelectAll(lsf)
        If lpsr.Value Is Nothing Then
            Exit Sub
        End If
        Dim erased As ObjectIdCollection = New ObjectIdCollection
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                For Each lineID As ObjectId In lpsr.Value.GetObjectIds
                    Dim lineE As Line = DirectCast(lineID.GetObject(OpenMode.ForRead), Line)
                    Dim rb As ResultBuffer = CLDS_GetXRecord(dTrans, lineE)
                    If Not rb Is Nothing Then
                        Dim ra As TypedValue() = rb.AsArray
                        Dim fn As String = ra(0).Value
                        Dim tn As String = ra(1).Value
                        If ((fn = p_fnode And tn = p_tnode) Or (fn = p_tnode And tn = p_fnode)) Then
                            lineE.UpgradeOpen()
                            lineE.Erase()
                            erased.Add(lineID)
                            Exit For
                        End If
                    End If
                Next
                dTrans.Commit()
            End Using
        End Using
        'doc.Database.ReclaimMemoryFromErasedObjects(erased)
        Application.UpdateScreen()
    End Sub
#End Region
#Region "Autoroute functions"
    Public Sub CLDS_ARouteDetail(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, Optional ByVal p_vessel As Integer = 0)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        p_dialog.tbARNo.Text = ""
        p_dialog.tbARFnode.Text = ""
        p_dialog.tbARFnode.ReadOnly = True
        p_dialog.tbARTNode.Text = ""
        p_dialog.tbARTNode.ReadOnly = True
        p_dialog.tbARStatus.Text = ""
        p_dialog.tbARLength.Text = ""
        p_dialog.rbARScopeW.Checked = False
        p_dialog.rbARScopeP.Checked = False
        p_dialog.rbARScopeB.Checked = False
        p_dialog.gbARScope.Enabled = False
        p_dialog.lvARSegments.Clear()
        p_dialog.lbRuleset.Visible = False
        p_dialog.lbPRuleSet.Visible = False
        p_dialog.cxRuleset.Items.Clear()
        p_dialog.cxRuleset.Visible = False
        CLDS_ARouteClear(p_cabid)
        uMulti.Clear()
        Dim rc(,) As String
        Dim rcc As Collection = Nothing
        Dim id As String = "CABID=""" & p_cabid & """"
        Dim nr As Integer = CLDS_Query(ed, 1, "CB", "RQ", id, rc, rcc, p_vessel)
        If nr <= 0 Then
            p_dialog.tbARStatus.Text = "No autoroute"
            p_dialog.tbARStatus.Font = New System.Drawing.Font(p_dialog.tbARStatus.Font, System.Drawing.FontStyle.Bold)
            If Val(p_dialog.tbNStatus.Text) < R_DRCNA Then
                p_dialog.btARSubmit.Enabled = True
            End If
            Exit Sub
        End If
        p_dialog.tbARNo.Text = rc(rcc("RQ_INO"), 1)
        p_dialog.tbARFnode.Text = rc(rcc("RQ_FROMID"), 1)
        p_dialog.tbARTNode.Text = rc(rcc("RQ_TOID"), 1)
        p_dialog.tbARStatus.Text = rc(rcc("RQ_COMPLETE"), 1)
        p_dialog.tbARLength.Text = rc(rcc("RQ_LENGTH"), 1)

        Dim flags As Integer = Val(rc(rcc("RQ_FLAGS"), 1))
        If (flags And f_BREAKS) > 0 Then
            p_dialog.rbARScopeB.Checked = True
        ElseIf p_dialog.tbARFnode.Text = p_dialog.tbFromNode.Text And p_dialog.tbARTNode.Text = p_dialog.tbToNode.Text Then
            p_dialog.rbARScopeW.Checked = True
        ElseIf p_dialog.tbARFnode.Text = "@-FDEV-@" And p_dialog.tbARTNode.Text = "@-TDEV-@" Then
            p_dialog.rbARScopeW.Checked = True
        Else
            p_dialog.rbARScopeP.Checked = True
        End If

        p_dialog.btARShow.Enabled = False
        p_dialog.cbARApprove.Enabled = False
        p_dialog.btARAccept.Enabled = False
        p_dialog.btARReject.Enabled = False

        If p_dialog.tbARNo.Text <> "" Then
            p_dialog.btARReject.Enabled = True
            If Left$(p_dialog.tbARStatus.Text, 1) = "Y" Or Left$(p_dialog.tbARStatus.Text, 1) = "P" Or Left$(p_dialog.tbARStatus.Text, 1) = "M" Then
                p_dialog.btARShow.Enabled = True
                p_dialog.btARAccept.Enabled = True
            End If
            If Left$(p_dialog.tbARStatus.Text, 1) = "Y" Then
                p_dialog.cbARApprove.Enabled = True
            End If
        End If

        Dim nm As Integer = Val(rc(rcc("RQ_MULTI"), 1))
        If nm > 0 Then
            p_dialog.cxRuleset.Items.Clear()
            uMulti.Clear()
            Dim mrc(,) As String
            Dim mrcc As Collection = Nothing
            Dim mid As String = "RRINO=""" & p_dialog.tbARNo.Text & """"
            Dim mnr As Integer = CLDS_Query(ed, 1, "CB", "MQ", mid, mrc, mrcc, p_vessel)
            If mnr > 0 Then
                For i As Integer = 1 To mnr - 1
                    Dim mrs As String = mrc(mrcc("MQ_RULESET"), i)
                    p_dialog.cxRuleset.Items.Add(mrs)
                    Dim mcl As New CLDS_AR_Multi
                    mcl.RRINO = Val(mrc(mrcc("MQ_INO"), i))
                    mcl.RRComplete = mrc(mrcc("MQ_COMPLETE"), i)
                    mcl.RRLength = Val(mrc(mrcc("MQ_LENGTH"), i))
                    mcl.RRFill = Val(mrc(mrcc("MQ_FILL"), i))
                    mcl.RRLock = Val(mrc(mrcc("MQ_LOCK"), i))
                    mcl.RRFlags = Val(mrc(mrcc("MQ_FLAGS"), i))
                    mcl.RRIgnore = Val(mrc(mrcc("MQ_IGNORE"), i))
                    mcl.RRRuleset = Val(mrs)
                    uMulti.Add(mrs, mcl)
                Next
                p_dialog.cxRuleset.Text = "0"
                p_dialog.cxRuleset.Visible = True
                p_dialog.lbRuleset.Visible = True
                p_dialog.lbPRuleSet.Visible = True
            End If
        Else
            Dim mcl As New CLDS_AR_Multi
            mcl.RRINO = Val(rc(rcc("RQ_INO"), 1))
            mcl.RRComplete = rc(rcc("RQ_COMPLETE"), 1)
            mcl.RRLength = Val(rc(rcc("RQ_LENGTH"), 1))
            mcl.RRFill = Val(rc(rcc("RQ_FILL"), 1))
            mcl.RRLock = Val(rc(rcc("RQ_LOCK"), 1))
            mcl.RRFlags = Val(rc(rcc("RQ_FLAGS"), 1))
            mcl.RRIgnore = Val(rc(rcc("RQ_IGNORE"), 1))
            mcl.RRRuleset = 0
            uMulti.Add("0", mcl)
            p_dialog.cxRuleset.Text = "0"
        End If
        CLDS_ARoutePrefs(p_dialog, 0)
    End Sub
    Public Sub CLDS_ARouteClear(ByVal p_cabid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim al As String = pPrefs.l_arte & "_" & p_cabid
        Dim ltvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.LayerName, al)}
        Dim lsf As SelectionFilter = New SelectionFilter(ltvs)
        Dim lpsr As PromptSelectionResult = ed.SelectAll(lsf)
        If lpsr.Value Is Nothing Then
            Exit Sub
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                For Each lineID As ObjectId In lpsr.Value.GetObjectIds
                    Dim lineE As Entity = DirectCast(lineID.GetObject(OpenMode.ForWrite), Entity)
                    lineE.Erase()
                Next
                CLDS_DeleteLayer(dTrans, doc, al)
                dTrans.Commit()
                Application.UpdateScreen()
            End Using
        End Using
    End Sub
    Public Sub CLDS_ARouteHilite(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, ByVal p_arno As String, Optional ByVal p_arcolour As Color = Nothing, Optional ByVal p_crcolour As Color = Nothing, Optional ByVal p_lv As ListView = Nothing)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_cabid = "" Or p_arno = "" Then
            Exit Sub
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        If p_dialog.cxRuleset.Text = "0" Or p_dialog.cxRuleset.Text = "" Then
            CLDS_RouteClear(p_dialog, p_cabid)
        End If
        If Not p_lv Is Nothing Then
            p_lv.Clear()
            p_lv.Columns.Clear()
        End If
        Dim xl As String = pPrefs.l_crte & "_" & p_cabid
        Dim rl As String = pPrefs.l_arte & "_" & p_cabid
        If Not (p_dialog.cxRuleset.Text = "0" Or p_dialog.cxRuleset.Text = "") Then
            rl = pPrefs.l_arte & "{" & p_dialog.cxRuleset.Text & "}" & "_" & p_cabid
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                Dim bt As BlockTable = DirectCast(dTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(dTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                Dim h_sgmt As Boolean = False, h_xsgmt As Boolean = False
                Dim id As String = "ARNO=""" & p_arno & """ FOCUS=""" & Trim(Str$(pProps.v_focus)) & """"
                For i As Integer = 1 To 1000
                    Dim nr As Integer = CLDS_Query(ed, i, "RQ", "RC", id, sc, scc)
                    If nr <= 0 Then
                        If i = 1 Then
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "No autoroute for cable " & p_cabid)
                        End If
                        Exit For
                    End If
                    If i = 1 And Not p_lv Is Nothing Then
                        p_lv.Columns.Add("Sequence")
                        p_lv.Columns.Add("Seg ID")
                        p_lv.Columns.Add("From node")
                        p_lv.Columns.Add("To node")
                        p_lv.Columns.Add("Tier")
                        p_lv.Columns.Add("Type")
                        p_lv.Columns.Add("Length")
                        p_lv.Columns.Add("V.Fill")
                    End If
                    For r As Integer = 1 To nr - 1
                        Dim id1 As String = sc(scc("RC_FROMNODE"), r)
                        Dim id2 As String = sc(scc("RC_TONODE"), r)
                        Dim xx As Integer = Val(sc(scc("RC_EXISTS"), r))
                        If Not p_lv Is Nothing Then
                            Dim lvi As New System.Windows.Forms.ListViewItem
                            lvi.Text = sc(scc("RC_SEQNO"), r)
                            If xx > 0 Then
                                'lvi.SubItems(0).Font = New System.Drawing.Font(lvi.Font, FontStyle.Italic)
                                lvi.BackColor = Drawing.Color.LightGray
                            ElseIf Val(sc(scc("RC_FILL"), r)) > Val(sc(scc("RC_THRESHOLD"), r)) Then
                                lvi.ForeColor = Drawing.Color.White
                                lvi.BackColor = Drawing.Color.Crimson
                            End If
                            lvi.SubItems.Add(sc(scc("RC_ID"), r))
                            lvi.SubItems.Add(id1)
                            lvi.SubItems.Add(id2)
                            lvi.SubItems.Add(sc(scc("RC_TIERID"), r))
                            lvi.SubItems.Add(sc(scc("RC_NRTYPE"), r))
                            lvi.SubItems.Add(sc(scc("RC_LENGTH"), r))
                            lvi.SubItems.Add(sc(scc("RC_FILL"), r))
                            p_lv.Items.Add(lvi)
                        End If
                        Dim nObj1 As ObjectId = CLDS_FindNode(dTrans, nd, id1)
                        Dim nObj2 As ObjectId = CLDS_FindNode(dTrans, nd, id2)
                        If Not (nObj1.IsNull Or nObj2.IsNull) Then
                            Dim n1 As BlockReference = TryCast(nObj1.GetObject(OpenMode.ForRead), BlockReference)
                            Dim n2 As BlockReference = TryCast(nObj2.GetObject(OpenMode.ForRead), BlockReference)
                            If Not (n1 Is Nothing Or n2 Is Nothing) Then
                                Dim nt As String = sc(scc("RC_NRTYPE"), r)
                                Dim ns As String = sc(scc("RC_SEGREGATION"), r)
                                Dim nl As String = sc(scc("RC_LENGTH"), r)
                                If id1 <> id2 Then
                                    Dim sl As New Line(n1.Position, n2.Position)
                                    If xx = 0 Then
                                        If Not h_sgmt Then
                                            Dim x_arte As Color
                                            If p_arcolour Is Nothing Then
                                                x_arte = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.c_arte)
                                            Else
                                                x_arte = p_arcolour
                                            End If
                                            CLDS_CheckLayer(dTrans, doc, rl, x_arte)
                                            h_sgmt = True
                                        End If
                                    Else
                                        If Not h_xsgmt Then
                                            Dim x_crte As Color
                                            If p_crcolour Is Nothing Then
                                                x_crte = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.c_crte)
                                            Else
                                                x_crte = p_crcolour
                                            End If
                                            CLDS_CheckLayer(dTrans, doc, xl, x_crte)
                                            h_xsgmt = True
                                        End If
                                    End If
                                    If xx = 0 Then
                                        CLDS_SetLayer(sl, rl, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = rl
                                    Else
                                        CLDS_SetLayer(sl, xl, "Segment " & id1 & ":" & id2)
                                        'sl.Layer = xl
                                    End If
                                    sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                                    btr.AppendEntity(sl)
                                    dTrans.AddNewlyCreatedDBObject(sl, True)
                                    CLDS_SetLineXRec(dTrans, sl, id1, id2, nt, ns, nl)
                                End If
                            End If
                        End If
                    Next
                    If Not p_lv Is Nothing Then
                        For r As Integer = 0 To p_lv.Columns.Count - 1
                            p_lv.Columns(r).Width = -2
                        Next
                        If tokens("PD_MULTITIER") <> "Y" Then
                            p_lv.Columns(4).Width = 0
                        End If
                        p_lv.Update()
                    End If
                Next
                dTrans.Commit()
                Application.UpdateScreen()
            End Using
        End Using
    End Sub
    Public Sub CLDS_AcceptAR(ByVal p_dialog As CLDS_Route_Container, Optional ByVal p_action As String = "UPDATE")
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim rrino As String = p_dialog.tbARNo.Text
        If rrino = "" Then
            Exit Sub
        End If
        Dim id As String = "RRINO=""" & rrino & """"
        If p_action = "UPDATE" Then
            Dim appr As String = "N"
            If p_dialog.cbARApprove.Checked Then
                appr = "Y"
            End If
            id = id & " APPR=""" & appr & """"
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer = CLDS_Query(ed, 1, p_action, "RQ", id, sc, scc)
        If nr <= 0 Then
            Exit Sub
        End If
        If p_action = "UPDATE" Then
            CLDS_RouteCableDetail(p_dialog, p_dialog.tbCabID.Text)
            Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromRgb(p_dialog.CRColour.R, p_dialog.CRColour.G, p_dialog.CRColour.B)
            CLDS_RouteHilite(p_dialog, p_dialog.tbCabID.Text, c, p_dialog.lvCRSegments)
        End If
        CLDS_ARouteDetail(p_dialog, p_dialog.tbCabID.Text)
        Dim result As String = sc(scc("RQ_RESULT"), 1)
        p_dialog.tbARStatus.Text = result
        If p_action = "UPDATE" Then
            p_dialog.btARSubmit.Enabled = False
        Else
            p_dialog.btARSubmit.Enabled = True
        End If
    End Sub
    Public Sub CLDS_AcceptMultiAR(ByVal p_dialog As CLDS_Multirow_Container, Optional ByVal p_action As String = "UPDATE")
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        For Each lvi As ListViewItem In p_dialog.lvMultiCable.Items
            If lvi.Checked Then

                Dim rrino As String = lvi.SubItems(8).Text
                If rrino = "" Then
                    Continue For
                End If
                Dim id As String = "RRINO=""" & rrino & """"
                If p_action = "UPDATE" Then
                    Dim appr As String = "N"
                    '            If p_dialog.cbARApprove.Checked Then
                    'appr = "Y"
                    'End If
                    id = id & " APPR=""" & appr & """"
                End If
                Dim sc(,) As String
                Dim scc As Collection = Nothing
                Dim nr As Integer = CLDS_Query(ed, 1, p_action, "RQ", id, sc, scc)
                If nr <= 0 Then
                    Continue For
                Else
                    lvi.Remove()
                End If
            End If
        Next
        If p_dialog.lvMultiCable.Items.Count = 0 Then
            pMultiCabDialog.mrToolStripButton1.Enabled = False
            pMultiCabDialog.mrToolStripButton1.ToolTipText = ""
            pMultiCabDialog.A1 = ""
            pMultiCabDialog.mrToolStripButton2.Enabled = False
            pMultiCabDialog.mrToolStripButton2.ToolTipText = ""
            pMultiCabDialog.A2 = ""
            pMultiCabDialog.ToolStrip1.Update()
        End If
    End Sub
    Public Sub CLDS_SubmitAR(ByVal p_dialog As CLDS_Route_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim id As String = p_dialog.tbCabID.Text
        If id = "" Then
            Exit Sub
        End If
        Dim fnode As String = p_dialog.tbARFnode.Text
        Dim tnode As String = p_dialog.tbARTNode.Text
        If fnode = "" Then
            fnode = "@-FDEV-@"
        End If
        If tnode = "" Then
            tnode = "@-TDEV-@"
        End If
        id = "CABID=""" & id & """"
        id = id & " FROMID=""" & fnode & """"
        id = id & " TOID=""" & tnode & """"
        Dim flags As Integer = CLDS_SetFlags(p_dialog)
        If p_dialog.rbARScopeB.Checked Then
            flags = flags + f_BREAKS
        ElseIf p_dialog.rbARScopeP.Checked Then
        End If
        If flags > 0 Then
            id = id & " FLAGS=""" & Trim(Str$(flags)) & """"
        End If
        Dim ignore As Integer = CLDS_SetIgnore(p_dialog)
        If ignore > 0 Then
            id = id & " IGNORE=""" & Trim(Str$(ignore)) & """"
        End If
        If p_dialog.tbFillThreshold.Text <> "" Then
            id = id & " FILL=""" & p_dialog.tbFillThreshold.Text & """"
        End If
        If p_dialog.tbLockThreshold.Text <> "" Then
            id = id & " LOCK=""" & p_dialog.tbLockThreshold.Text & """"
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer = CLDS_Query(ed, 1, "INSERT", "RQ", id, sc, scc)
        If nr <= 0 Then
            Exit Sub
        End If
        Dim rrino As String = sc(scc("RQ_INO"), 1)
        p_dialog.tbARNo.Text = rrino
        If pPrefs.x_rfsh = 0 Then
            CLDS_ARouteDetail(p_dialog, p_dialog.tbCabID.Text)
            Exit Sub
        End If
        Dim rps As Integer = Math.Round((1000.0 / pPrefs.x_rfsh), 0)
        Dim ars As Integer = 0
        p_dialog.Cursor = Cursors.WaitCursor
        For i As Integer = 1 To pPrefs.x_timo * rps
            'CLDS_ARouteDetail(p_dialog, p_dialog.tbCabID.Text)
            If i Mod rps = 1 Then
                Dim rc(,) As String
                Dim rcc As Collection = Nothing
                Dim rid As String = "CABID=""" & p_dialog.tbCabID.Text & """"
                Dim rnr As Integer = CLDS_Query(ed, 1, "CB", "RQ", rid, rc, rcc)
                If rnr <= 0 Then
                    Exit For
                End If
                p_dialog.tbARNo.Text = rc(rcc("RQ_INO"), 1)
                p_dialog.tbARNo.Update()
                p_dialog.tbARStatus.Text = rc(rcc("RQ_COMPLETE"), 1)
                ars = ars + 1
                If ars > 1 Then
                    p_dialog.tbARStatus.Text = p_dialog.tbARStatus.Text & " {" & Trim(Str$(ars)) & "}"
                End If
                p_dialog.tbARStatus.Update()
                If p_dialog.tbARNo.Text = "" Then
                    Exit For
                End If
                Dim s As String = Mid$(p_dialog.tbARStatus.Text, 1, 1)
                If s <> "Q" And s <> "A" Then
                    Exit For
                End If
            End If
            Thread.Sleep(pPrefs.x_rfsh)
        Next
        p_dialog.Cursor = Cursors.Default
        CLDS_ARouteDetail(p_dialog, p_dialog.tbCabID.Text)
    End Sub
    Public Sub CLDS_SubmitMultiAR(ByVal p_dialog As CLDS_Multirow_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        For Each lvi As ListViewItem In p_dialog.lvMultiCable.Items
            If lvi.Checked Then
                Dim id As String = lvi.SubItems(0).Text
                If id = "" Then
                    Exit Sub
                End If
                Dim fnode As String = lvi.SubItems(2).Text
                If InStr(fnode, "@") > 0 Then
                    fnode = Mid$(fnode, InStr(fnode, "@") + 1)
                Else
                    fnode = ""
                End If
                If InStr(fnode, "[") > 0 Then
                    fnode = Mid$(fnode, 1, InStr(fnode, "[") - 1)
                End If
                Dim tnode As String = lvi.SubItems(3).Text
                If InStr(tnode, "@") > 0 Then
                    tnode = Mid$(tnode, InStr(tnode, "@") + 1)
                Else
                    tnode = ""
                End If
                If InStr(tnode, "[") > 0 Then
                    tnode = Mid$(tnode, 1, InStr(tnode, "[") - 1)
                End If
                If fnode = "" Then
                    fnode = "@-FDEV-@"
                End If
                If tnode = "" Then
                    tnode = "@-TDEV-@"
                End If
                id = "CABID=""" & id & """"
                id = id & " FROMID=""" & fnode & """"
                id = id & " TOID=""" & tnode & """"
                Dim flags As Integer = 0
                'Dim flags As Integer = CLDS_SetFlags(p_dialog)
                'If p_dialog.rbARScopeB.Checked Then
                'flags = flags + f_BREAKS
                'ElseIf p_dialog.rbARScopeP.Checked Then
                'End If
                If flags > 0 Then
                    id = id & " FLAGS=""" & Trim(Str$(flags)) & """"
                End If
                'Dim ignore As Integer = CLDS_SetIgnore(p_dialog)
                'If ignore > 0 Then
                'id = id & " IGNORE=""" & Trim(Str$(ignore)) & """"
                'End If
                'If p_dialog.tbFillThreshold.Text <> "" Then
                'id = id & " FILL=""" & p_dialog.tbFillThreshold.Text & """"
                'End If
                'If p_dialog.tbLockThreshold.Text <> "" Then
                'id = id & " LOCK=""" & p_dialog.tbLockThreshold.Text & """"
                'End If
                Dim sc(,) As String
                Dim scc As Collection = Nothing
                Dim nr As Integer = CLDS_Query(ed, 1, "INSERT", "RQ", id, sc, scc)
                If nr <= 0 Then
                    Continue For
                Else
                    lvi.Remove()
                End If
                Dim rrino As String = sc(scc("RQ_INO"), 1)
            End If
        Next
        If p_dialog.lvMultiCable.Items.Count = 0 Then
            pMultiCabDialog.mrToolStripButton1.Enabled = False
            pMultiCabDialog.mrToolStripButton1.ToolTipText = ""
            pMultiCabDialog.A1 = ""
            pMultiCabDialog.mrToolStripButton2.Enabled = False
            pMultiCabDialog.mrToolStripButton2.ToolTipText = ""
            pMultiCabDialog.A2 = ""
            pMultiCabDialog.ToolStrip1.Update()
        End If
    End Sub
    Public Function CLDS_SetFlags(ByVal p_dialog As CLDS_Route_Container, Optional ByVal p_auto As Boolean = False) As Integer
        Dim f As Integer = 0
        If p_dialog.cbARPartial.Checked Then
            f = f + f_PARTIAL
        End If
        If p_dialog.cbARPartial.Checked Then
            f = f + f_RETAIN
        End If
        If p_auto And p_dialog.cbARAuto.Checked Then
            f = f + f_ACCEPT
        End If
        Return f
    End Function
    Public Function CLDS_SetIgnore(ByVal p_dialog As CLDS_Route_Container) As Integer
        Dim i As Integer = 0
        If p_dialog.cbIHotCodes.Checked Then
            i = i + C_HOT
        End If
        If p_dialog.cbIMBR.Checked Then
            i = i + C_MBR
        End If
        If p_dialog.cbILocks.Checked Then
            i = i + C_LOCKS
        End If
        If p_dialog.cbIReqd.Checked Then
            i = i + C_REQD
        End If
        If p_dialog.cbISeg.Checked Then
            i = i + C_SEG
        End If
        If p_dialog.cbIMinMax.Checked Then
            i = i + C_MAXMIN
        End If
        If p_dialog.cbIProhib.Checked Then
            i = i + C_PROHIB
        End If
        If p_dialog.cbIZones.Checked Then
            i = i + C_ZONE
        End If
        If p_dialog.cbIIsol.Checked Then
            i = i + C_ISOL
        End If
        Return i
    End Function
    Public Sub CLDS_ARoutePrefs(ByVal p_dialog As CLDS_Route_Container, ByVal p_rs As Integer)
        If p_rs < 0 Then
            Exit Sub
        End If
        p_dialog.lbPRuleSet.Text = "Rule-set: " + Trim(Str$(p_rs))
        p_dialog.cbARAuto.Enabled = False
        p_dialog.cbARPartial.Enabled = False
        p_dialog.cbIHotCodes.Enabled = False
        p_dialog.cbIIsol.Enabled = False
        p_dialog.cbILocks.Enabled = False
        p_dialog.cbIMBR.Enabled = False
        p_dialog.cbIMinMax.Enabled = False
        p_dialog.cbIProhib.Enabled = False
        p_dialog.cbIReqd.Enabled = False
        p_dialog.cbISeg.Enabled = False
        p_dialog.cbIZones.Enabled = False
        p_dialog.tbFillThreshold.Enabled = False
        p_dialog.tbLockThreshold.Enabled = False
        Dim mr As CLDS_AR_Multi = M_RULESET.Item(p_rs)
        Dim f As Integer = mr.RRFlags
        Dim i As Integer = mr.RRIgnore
        p_dialog.cbARAuto.Checked = ((f And f_ACCEPT) > 0)
        p_dialog.cbARPartial.Checked = ((f And f_PARTIAL) > 0)
        p_dialog.cbIHotCodes.Checked = ((i And C_HOT) > 0)
        p_dialog.cbIIsol.Checked = ((i And C_ISOL) > 0)
        p_dialog.cbILocks.Checked = ((i And C_LOCKS) > 0)
        p_dialog.cbIMBR.Checked = ((i And C_MBR) > 0)
        p_dialog.cbIMinMax.Checked = ((i And C_MAXMIN) > 0)
        p_dialog.cbIProhib.Checked = ((i And C_PROHIB) > 0)
        p_dialog.cbIReqd.Checked = ((i And C_REQD) > 0)
        p_dialog.cbISeg.Checked = ((i And C_SEG) > 0)
        p_dialog.cbIZones.Checked = ((i And C_ZONE) > 0)
        p_dialog.tbFillThreshold.Text = Trim(Str$(mr.RRFill))
        p_dialog.tbLockThreshold.Text = Trim(Str$(mr.RRLock))
        p_dialog.btClearPrefs.Enabled = False
        p_dialog.btDefaultPrefs.Enabled = False
        p_dialog.btSavePrefs.Enabled = False
    End Sub
    Public Sub CLDS_RoutePrefs(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, Optional ByVal p_vessel As Integer = 0)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim id As String = p_cabid
        If id = "" Then
            Exit Sub
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer = CLDS_Query(ed, 1, "CB", "PF", id, sc, scc, p_vessel)
        If nr <= 0 Then
            Exit Sub
        End If
        Dim xcabno As String = sc(scc("PF_CABNO"), 1)
        p_dialog.cbARAuto.Checked = (sc(scc("PF_AUTOACCEPT_VAL"), 1) = "Y")
        p_dialog.cbARPartial.Checked = (sc(scc("PF_PARTIALROUTES"), 1) = "Y")
        p_dialog.cbIHotCodes.Checked = (sc(scc("PF_SKIP_HOTCODE"), 1) = "Y")
        p_dialog.cbIIsol.Checked = (sc(scc("PF_SKIP_ISOLATED"), 1) = "Y")
        p_dialog.cbILocks.Checked = (sc(scc("PF_SKIP_LOCKSEG"), 1) = "Y")
        p_dialog.cbIMBR.Checked = (sc(scc("PF_SKIP_MBR"), 1) = "Y")
        p_dialog.cbIMinMax.Checked = (sc(scc("PF_SKIP_MINMAX"), 1) = "Y")
        p_dialog.cbIProhib.Checked = (sc(scc("PF_SKIP_PROHIB"), 1) = "Y")
        p_dialog.cbIReqd.Checked = (sc(scc("PF_SKIP_REQD"), 1) = "Y")
        p_dialog.cbISeg.Checked = (sc(scc("PF_SKIP_CABSEG"), 1) = "Y")
        p_dialog.cbIZones.Checked = (sc(scc("PF_SKIP_ZONES"), 1) = "Y")
        p_dialog.tbFillThreshold.Text = sc(scc("PF_FILL_THRESHOLD"), 1)
        p_dialog.tbLockThreshold.Text = sc(scc("PF_LOCK_THRESHOLD"), 1)

        p_dialog.tbFlags.Text = Str$(CLDS_SetFlags(p_dialog, True))
        p_dialog.tbIgnore.Text = Str$(CLDS_SetIgnore(p_dialog))

        p_dialog.cbARAuto.Enabled = True
        p_dialog.cbARPartial.Enabled = True
        p_dialog.cbIHotCodes.Enabled = True
        p_dialog.cbIIsol.Enabled = True
        p_dialog.cbILocks.Enabled = True
        p_dialog.cbIMBR.Enabled = True
        p_dialog.cbIMinMax.Enabled = True
        p_dialog.cbIProhib.Enabled = True
        p_dialog.cbIReqd.Enabled = True
        p_dialog.cbISeg.Enabled = True
        p_dialog.cbIZones.Enabled = True
        p_dialog.tbFillThreshold.Enabled = True
        p_dialog.tbLockThreshold.Enabled = True

        p_dialog.btClearPrefs.Enabled = False
        If xcabno = "0" Then
            p_dialog.btDefaultPrefs.Enabled = False
        Else
            p_dialog.btDefaultPrefs.Enabled = True
        End If
        p_dialog.btSavePrefs.Enabled = False
    End Sub
    Public Sub CLDS_SaveRoutePrefs(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim id As String = p_cabid
        If id = "" Then
            Exit Sub
        End If
        id = "CABID=""" & id & """"
        Dim flags As Integer = CLDS_SetFlags(p_dialog, True)
        If flags > 0 Then
            id = id & " FLAGS=""" & Trim(Str$(flags)) & """"
        End If
        Dim ignore As Integer = CLDS_SetIgnore(p_dialog)
        If ignore > 0 Then
            id = id & " IGNORE=""" & Trim(Str$(ignore)) & """"
        End If
        If p_dialog.tbFillThreshold.Text <> "" Then
            id = id & " FILL=""" & p_dialog.tbFillThreshold.Text & """"
        End If
        If p_dialog.tbLockThreshold.Text <> "" Then
            id = id & " LOCK=""" & p_dialog.tbLockThreshold.Text & """"
        End If
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer = CLDS_Query(ed, 1, "INSERT", "PF", id, sc, scc)
        If nr <= 0 Then
            Exit Sub
        End If
        CLDS_RoutePrefs(p_dialog, p_cabid)
    End Sub
    Public Sub CLDS_DeleteRoutePrefs(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim id As String = p_cabid
        If id = "" Then
            Exit Sub
        End If
        id = "CABID=""" & id & """"
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer = CLDS_Query(ed, 1, "DELETE", "PF", id, sc, scc)
        If nr <= 0 Then
            Exit Sub
        End If
        CLDS_RoutePrefs(p_dialog, p_cabid)
    End Sub
#End Region
#Region "Manual route functions"
    Public Function CLDS_FindBreak(ByVal p_dialog As CLDS_Route_Container) As String
        Dim b_node As String = p_dialog.tbFromNode.Text
        If b_node = "" Then
            Return b_node
        End If
        For i As Integer = 0 To p_dialog.lvCRSegments.Items.Count - 1
            Dim lvi As ListViewItem = p_dialog.lvCRSegments.Items(i)
            Dim f_node As String = lvi.SubItems(2).Text
            If f_node = b_node Then
                b_node = lvi.SubItems(3).Text
            Else
                Return b_node
            End If
        Next
        Return b_node
    End Function
    Public Sub CLDS_ReverseRoute(ByVal p_dialog As CLDS_Route_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim v_cabid As String = p_dialog.tbCabID.Text
        Dim id As String = ""
        id = "CABID=""" & v_cabid & """"
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        Dim nr As Integer = CLDS_Query(ed, 1, "REVERSE", "CR", id, sc, scc)
        If nr <= 0 Then
            Exit Sub
        End If
        Dim r As String = sc(scc("CR_RESULT"), 1)
        If Mid$(r, 1, 2) <> "OK" Then
            MsgBox(r, MsgBoxStyle.Exclamation, "CMPIC Reverse Route")
        End If
    End Sub
    Public Sub CLDS_SetMRStart(ByVal p_dialog As CLDS_Route_Container, Optional ByVal p_node As String = "")
        Dim s_node As String = p_node
        Dim x_node As String = ""
        CLDS_PickOneNode(x_node)
        If s_node = "" Then
            If Val(p_dialog.tbNStatus.Text) = 0 Then
                If x_node = "" Then
                    s_node = p_dialog.tbFromNode.Text
                Else
                    s_node = x_node
                End If
            Else
                If x_node = "" Then
                    s_node = CLDS_FindBreak(p_dialog)
                Else
                    s_node = x_node
                End If
            End If
        End If
        If s_node = "" Then
            p_dialog.btMRGoNext.Enabled = False
        Else
            p_dialog.btMRGoNext.Enabled = True
        End If
        p_dialog.tbMRStart.Text = s_node
    End Sub
    Public Sub CLDS_GetMRNext(ByVal p_dialog As CLDS_Route_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        CLDS_SelectNode(p_dialog.tbMRStart.Text, "", True)
        Dim id As String = ""
        id = "CABID=""" & p_dialog.tbCabID.Text & """"
        id = id & " FROMID=""" & p_dialog.tbMRStart.Text & """"
        'Dim flags As Integer = CLDS_SetFlags(p_dialog)
        Dim flags As Integer = 0
        If p_dialog.cbMRAnalysis.Checked Then
            flags = 1024
        End If
        If flags > 0 Then
            id = id & " FLAGS=""" & Trim(Str$(flags)) & """"
        End If
        Dim ignore As Integer = CLDS_SetIgnore(p_dialog)
        If ignore > 0 Then
            id = id & " IGNORE=""" & Trim(Str$(ignore)) & """"
        End If
        If p_dialog.tbFillThreshold.Text <> "" Then
            id = id & " FILL=""" & p_dialog.tbFillThreshold.Text & """"
        End If
        If p_dialog.tbLockThreshold.Text <> "" Then
            id = id & " LOCK=""" & p_dialog.tbLockThreshold.Text & """"
        End If
        Dim v_lv As ListView = p_dialog.lvMRNext
        v_lv.Clear()
        Dim sc(,) As String
        Dim scc As Collection = Nothing
        For i As Integer = 1 To 1000
            Dim nr As Integer = CLDS_Query(ed, i, "CB", "MR", id, sc, scc)
            If nr <= 0 Then
                If i = 1 Then
                    MsgBox("No eligible nodes", MsgBoxStyle.Information, "CMPIC Manual Route")
                End If
                Exit For
            End If
            If i = 1 Then
                v_lv.Columns.Add("To node")
                v_lv.Columns.Add("Tier")
                v_lv.Columns.Add("Type")
                v_lv.Columns.Add("Length [" + tokens("PD_LENUOM") + "]")
                v_lv.Columns.Add("Fill %")
                v_lv.Columns.Add("NRID")
                v_lv.Columns.Add("Eligiblity")
                v_lv.Columns.Add("Reason")
            End If
            For r As Integer = 1 To nr - 1
                Dim lvi As ListViewItem = New ListViewItem
                lvi.Text = sc(scc("MR_TOID"), r)
                lvi.SubItems.Add(sc(scc("MR_TIERNO"), r))
                lvi.SubItems.Add(sc(scc("MR_NRTYPE"), r))
                lvi.SubItems.Add(sc(scc("MR_LENGTH"), r))
                lvi.SubItems.Add(sc(scc("MR_FILL"), r))
                lvi.SubItems.Add(sc(scc("MR_NRID"), r))
                lvi.SubItems.Add(sc(scc("MR_ELIGIBILITY"), r))
                If Val(sc(scc("MR_ELIGIBILITY"), r)) < 0 Then
                    lvi.BackColor = Drawing.Color.LightGray
                End If
                lvi.SubItems.Add(sc(scc("MR_REASON"), r))
                v_lv.Items.Add(lvi)
            Next
        Next
        For r As Integer = 0 To v_lv.Columns.Count - 1
            v_lv.Columns(r).Width = -2
        Next
        If v_lv.Columns.Count > 5 Then
            v_lv.Columns(6).Width = 0
        End If
        v_lv.Update()
    End Sub
    Public Sub CLDS_SetMRNext(ByVal p_dialog As CLDS_Route_Container, ByVal p_tonode As String, ByVal p_tierno As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_dialog.tbMRStart.Text = "" Then
            Exit Sub
        End If
        If p_tonode = "" Then
            Exit Sub
        End If
        Dim v_tonode As String = p_tonode
        Dim v_tierno As String = p_tierno
        Dim auto As Boolean = True
        While auto
            If Not p_dialog.cbMRSemi.Checked Then
                auto = False
            End If
            Dim v_cabid As String = p_dialog.tbCabID.Text
            Dim id As String = ""
            id = "CABID=""" & v_cabid & """"
            id = id & " FROMID=""" & p_dialog.tbMRStart.Text & """"
            id = id & " TOID=""" & v_tonode & """"
            id = id & " TIERNO=""" & v_tierno & """"
            Dim sc(,) As String
            Dim scc As Collection = Nothing
            Dim nr As Integer = CLDS_Query(ed, 1, "INSERT", "MR", id, sc, scc)
            If nr <= 0 Then
                Exit Sub
            End If
            Dim r As String = sc(scc("MR_RESULT"), 1)
            If Mid$(r, 1, 3) = "OK:" Then
                Dim x() As String
                x = Split(r, ":")
                p_dialog.tbNStatus.Text = x(1)
                p_dialog.tbNStatus.Update()
                p_dialog.tbStatus.Text = x(2)
                p_dialog.tbStatus.Update()
                p_dialog.tbMRLength.Text = x(3)
                p_dialog.tbMRLength.Update()
                CLDS_RouteSegmentHilite(p_dialog, v_cabid, p_dialog.tbMRStart.Text, v_tonode)
                If Val(p_dialog.tbNStatus.Text) < R_DRCNA Then
                    p_dialog.tbMRStart.Text = v_tonode
                    p_dialog.tbMRStart.Update()
                    CLDS_GetMRNext(p_dialog)
                    If auto Then
                        Dim n As Integer = 0
                        Dim lv As ListView = p_dialog.lvMRNext
                        If lv.Items.Count = 0 Then
                            auto = False
                        Else
                            For i As Integer = 0 To lv.Items.Count - 1
                                Dim lvi As ListViewItem = lv.Items(i)
                                Dim e As Integer = Val(lvi.SubItems(6).Text)
                                If e > 0 Then
                                    n = n + 1
                                    v_tonode = lvi.Text
                                    v_tierno = lvi.SubItems(1).Text
                                End If
                                If n = 0 Or n > 1 Then
                                    auto = False
                                End If
                            Next
                        End If
                    End If
                Else
                    MsgBox("Route complete", MsgBoxStyle.Exclamation, "CMPIC Manual Route")
                    p_dialog.lvMRNext.Clear()
                    p_dialog.tbMRStart.Text = ""
                    p_dialog.tbMRStart.Update()
                    CLDS_RouteCableDetail(p_dialog, v_cabid)
                    Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromRgb(p_dialog.CRColour.R, p_dialog.CRColour.G, p_dialog.CRColour.B)
                    CLDS_RouteHilite(p_dialog, v_cabid, c, p_dialog.lvCRSegments)
                    Dim nobj() As ObjectId
                    ed.SetImpliedSelection(nobj)
                    auto = False
                End If
            Else
                auto = False
            End If
        End While
    End Sub
    Public Function CLDS_DelCRLVItem(ByVal p_dialog As CLDS_Route_Container, ByVal p_cabid As String, ByVal p_fnode As String, ByVal p_tnode As String) As String
        Dim lv As ListView = p_dialog.lvCRSegments
        Dim nf As String = ""
        For i As Integer = 0 To lv.Items.Count - 1
            Dim lvi As ListViewItem = lv.Items(i)
            Dim fn As String = lvi.SubItems(2).Text
            Dim tn As String = lvi.SubItems(3).Text
            If ((fn = p_fnode And tn = p_tnode) Or (p_fnode = "-" And tn = p_tnode) Or (p_tnode = "-" And fn = p_fnode)) Then
                lvi.Remove()
                lv.Update()
                CLDS_RouteSegmentUnHilite(p_cabid, fn, tn)
                If p_fnode = "-" And tn = p_tnode Then
                    nf = fn
                End If
                Exit For
            End If
        Next
        Return nf
    End Function
    Public Sub CLDS_DelMRPrev(ByVal p_dialog As CLDS_Route_Container)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim auto As Boolean = True
        Dim v_cabid As String = p_dialog.tbCabID.Text
        Dim c As Autodesk.AutoCAD.Colors.Color = Autodesk.AutoCAD.Colors.Color.FromRgb(p_dialog.CRColour.R, p_dialog.CRColour.G, p_dialog.CRColour.B)
        If p_dialog.lvCRSegments.Items.Count = 0 Then
            CLDS_RouteHilite(p_dialog, v_cabid, c, p_dialog.lvCRSegments)
        End If
        While auto
            Dim v_fromnode As String = p_dialog.tbMRStart.Text
            Dim clv As ListView = p_dialog.lvCRSegments
            Dim cfn As String = ""
            Dim ctn As String = ""
            Dim ltn As String = ""
            For i As Integer = clv.Items.Count - 1 To 0 Step -1
                Dim clvi As ListViewItem = clv.Items(i)
                Dim xfn As String = clvi.SubItems(2).Text
                Dim xtn As String = clvi.SubItems(3).Text
                If ltn = "" Then
                    ltn = xtn
                End If
                If v_fromnode = "" Then
                    v_fromnode = ltn
                End If
                If xtn = v_fromnode Then
                    cfn = xfn
                    ctn = xtn
                    Exit For
                End If
            Next
            If cfn = "" Then
                Exit Sub
            End If
            If Not p_dialog.cbMRSemi.Checked Then
                auto = False
            End If
            Dim id As String = "CABID=""" & v_cabid & """"
            id = id & " FOCUS=""" & v_props.v_focus & """"
            Dim sid As String = id & " FNODE=""" & cfn & """ TNODE=""" & ctn & """"
            Dim sc(,) As String
            Dim scc As Collection = Nothing
            Dim nr As Integer = CLDS_Query(ed, 1, "DELETE", "CR", sid, sc, scc)
            If nr <= 0 Then
                Exit Sub
            End If
            Dim r As String = sc(scc("CR_RESULT"), 1)
            If Mid$(r, 1, 3) = "OK:" Then
                Dim x() As String
                x = Split(r, ":")
                p_dialog.tbNStatus.Text = x(1)
                p_dialog.tbNStatus.Update()
                p_dialog.tbStatus.Text = x(2)
                p_dialog.tbStatus.Update()
                p_dialog.tbMRLength.Text = x(3)
                p_dialog.tbMRLength.Update()
                p_dialog.tbCRLength.Text = p_dialog.tbMRLength.Text
                p_dialog.tbCRLength.Update()
            Else
                Exit Sub
            End If
            'CLDS_RouteCableDetail(p_dialog, v_cabid)
            'CLDS_RouteHilite(v_cabid, c, p_dialog.lvCRSegments)
            CLDS_DelCRLVItem(p_dialog, v_cabid, cfn, ctn)
            If cfn = ctn Then
                cfn = CLDS_DelCRLVItem(p_dialog, v_cabid, "-", ctn)
                CLDS_DelCRLVItem(p_dialog, v_cabid, ctn, "-")
                If cfn = "" Then
                    cfn = ctn
                End If
            End If
            If Val(p_dialog.tbNStatus.Text) > R_DSNR Then
                p_dialog.tbMRStart.Text = cfn
                p_dialog.tbMRStart.Update()
                CLDS_GetMRNext(p_dialog)
                If auto Then
                    Dim n As Integer = 0
                    Dim lv As ListView = p_dialog.lvMRNext
                    If lv.Items.Count = 0 Then
                        auto = False
                    Else
                        For i As Integer = 0 To lv.Items.Count - 1
                            Dim lvi As ListViewItem = lv.Items(i)
                            Dim e As Integer = Val(lvi.SubItems(6).Text)
                            If e > 0 Then
                                n = n + 1
                            End If
                            If n = 0 Or n > 1 Then
                                auto = False
                            End If
                        Next
                    End If
                End If
            Else
                MsgBox("Route empty", MsgBoxStyle.Exclamation, "CMPIC Manual Route")
                CLDS_RouteCableDetail(p_dialog, v_cabid)
                CLDS_RouteHilite(p_dialog, v_cabid, c, p_dialog.lvCRSegments)
                p_dialog.lvMRNext.Clear()
                p_dialog.tbMRStart.Text = ""
                p_dialog.tbMRStart.Update()
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
                auto = False
            End If
        End While
    End Sub
#End Region
#Region "Library data"
    Public Function CLDS_PopulateCollection(ByVal p_context As String, ByVal p_require As String, ByVal p_column As String, Optional ByVal p_index As String = "") As Collection
        Dim c As Collection = Nothing
        Dim r As Integer = 0
        For j As Integer = 1 To 1000
            Dim arr As String(,)
            Dim acc As Collection
            Dim n As Integer = CLDS_Query(Nothing, j, p_context, p_require, "%", arr, acc)
            If n <= 0 Then
                Exit For
            End If
            For i As Integer = 1 To n - 1
                If r = 0 Then
                    c = New Collection
                End If
                If p_index = "" Then
                    c.Add(arr(acc(p_require & "_" & p_column), i))
                Else
                    c.Add(arr(acc(p_require & "_" & p_column), i), arr(acc(p_require & "_" & p_index), i))
                End If
                r = r + 1
            Next
        Next
        Return c
    End Function
    Public Function CLDS_GetCMPICVersion() As Collection
        Dim c As Collection = Nothing
        Dim r As Integer = 0
        Dim arr As String(,)
        Dim acc As Collection
        Dim n As Integer = CLDS_Query(Nothing, 1, "PIC", "VERSION", "%", arr, acc)
        If n <= 0 Then
            Return c
        End If
        c = New Collection
        c.Add(arr(acc("VERSION_STRING"), 1), "STRING")
        c.Add(arr(acc("VERSION_NUMBER"), 1), "NUMBER")
        Return c
    End Function
    Public Sub CLDS_PopulateCB(ByVal p_cb As ComboBox, ByVal p_coll As Collection, Optional ByVal p_default As String = "")
        If p_cb Is Nothing Then
            Exit Sub
        End If
        p_cb.Items.Clear()
        If p_default <> "" Then
            p_cb.Items.Add(p_default)
            p_cb.Text = p_default
        End If
        If p_coll Is Nothing Then
            Exit Sub
        End If
        For i As Integer = 1 To p_coll.Count
            p_cb.Items.Add(p_coll.Item(i))
        Next
    End Sub
    Public Sub CLDS_PopulateCB(ByVal p_cb As ComboBox, ByVal p_context As String, ByVal p_require As String, ByVal p_column As String)
        If p_cb Is Nothing Then
            Exit Sub
        End If
        p_cb.Items.Clear()
        For j As Integer = 1 To 1000
            Dim arr As String(,)
            Dim acc As Collection
            Dim n As Integer = CLDS_Query(Nothing, j, p_context, p_require, "%", arr, acc)
            If n <= 0 Then
                Exit For
            End If
            For i As Integer = 1 To n - 1
                p_cb.Items.Add(arr(acc(p_require & "_" & p_column), i))
            Next
        Next
    End Sub
    Public Sub CLDS_PopulateLB(ByVal p_lb As ListBox, ByVal p_context As String, ByVal p_require As String, ByVal p_column As String)
        If p_lb Is Nothing Then
            Exit Sub
        End If
        p_lb.Items.Clear()
        For j As Integer = 1 To 1000
            Dim arr As String(,)
            Dim acc As Collection
            Dim n As Integer = CLDS_Query(Nothing, j, p_context, p_require, "%", arr, acc)
            If n <= 0 Then
                Exit For
            End If
            For i As Integer = 1 To n - 1
                p_lb.Items.Add(arr(acc(p_require & "_" & p_column), i))
            Next
        Next
    End Sub
#End Region
#Region "Entity highlight/selection"
    Public Sub CancelPrior()
        Dim ok As Boolean = True
        Try
            Dim i As Integer = acedPostCommand("CANCELCMD")
        Catch e As System.EntryPointNotFoundException
            ok = False
        End Try
        If ok Then
            Exit Sub
        End If
        Try
            Dim i As Integer = acedPostCommand64("CANCELCMD")
        Catch e As System.EntryPointNotFoundException
            ok = False
        End Try
    End Sub
    Public Function CLDS_FilterOrigin() As SelectionFilter
        Dim ntvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Start, "INSERT"), _
            New TypedValue(DxfCode.BlockName, pPrefs.b_orgn)}
        Dim nsf As SelectionFilter = New SelectionFilter(ntvs)
        Return nsf
    End Function
    Public Function CLDS_FilterAllNodes() As SelectionFilter
        Dim bn As String = pPrefs.b_node
        If pPrefs.b_nodm <> bn Then
            bn = bn & "," & pPrefs.b_nodm
        End If
        Dim ntvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_node), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_nodm), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_isrt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_updt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_dele), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "INSERT"), _
                New TypedValue(DxfCode.BlockName, bn), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim nsf As SelectionFilter = New SelectionFilter(ntvs)
        Return nsf
    End Function
    Public Function CLDS_XFilterAllNodes(ByVal p_trans As Transaction) As SelectionFilter
        Dim lg As LayerGroup = CLDS_LayerGroup()
        If lg Is Nothing Then
            Return CLDS_FilterAllNodes()
        Else
            Dim bn As String = pPrefs.b_node
            If pPrefs.b_nodm <> bn Then
                bn = bn & "," & pPrefs.b_nodm
            End If
            Dim tvl As New System.Collections.Generic.List(Of TypedValue)(lg.LayerIds.Count + 6)
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<and"))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<or"))
            For Each lObj As ObjectId In lg.LayerIds
                If lObj.IsValid And Not (lObj.IsErased Or lObj.IsEffectivelyErased Or lObj.IsNull) Then
                    Dim ltr As LayerTableRecord = TryCast(p_trans.GetObject(lObj, OpenMode.ForRead), LayerTableRecord)
                    If Not ltr Is Nothing Then
                        If Not (ltr.Name = pPrefs.l_warn Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_warn) + 1) = pPrefs.l_warn & "_" Or _
                                ltr.Name = pPrefs.l_eror Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_eror) + 1) = pPrefs.l_eror & "_" Or _
                                ltr.Name = pPrefs.l_hlit Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_hlit) + 1) = pPrefs.l_hlit & "_") Then
                            tvl.Add(New TypedValue(CInt(DxfCode.LayerName), ltr.Name))
                        End If
                    End If
                End If
            Next
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "or>"))
            tvl.Add(New TypedValue(DxfCode.Start, "INSERT"))
            tvl.Add(New TypedValue(DxfCode.BlockName, bn))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "and>"))
            Dim nsf As SelectionFilter = New SelectionFilter(tvl.ToArray())
            Return nsf
        End If
    End Function
    Public Function CLDS_FilterPendingNodes() As SelectionFilter
        Dim bn As String = pPrefs.b_node
        If pPrefs.b_nodm <> bn Then
            bn = bn & "," & pPrefs.b_nodm
        End If
        Dim ntvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_isrt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_updt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_dele), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "INSERT"), _
                New TypedValue(DxfCode.BlockName, bn), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim nsf As SelectionFilter = New SelectionFilter(ntvs)
        Return nsf
    End Function
    Public Function CLDS_SelectOrigin(ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_FilterOrigin()
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_SelectAllNodes(ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_FilterAllNodes()
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_XSelectAllNodes(ByVal p_trans As Transaction, ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_XFilterAllNodes(p_trans)
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_SelectPendingNodes(ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_FilterPendingNodes()
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_FilterSegments() As SelectionFilter
        Dim ltvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_jump), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_sgmt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_used), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_appd), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "LINE"), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim lsf As SelectionFilter = New SelectionFilter(ltvs)
        Return lsf
    End Function
    Public Function CLDS_FilterAllSegments() As SelectionFilter
        Dim ltvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_sgmt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_jump), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_used), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_appd), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_isrt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_updt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_dele), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_brek), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "LINE"), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim lsf As SelectionFilter = New SelectionFilter(ltvs)
        Return lsf
    End Function
    Public Function CLDS_XFilterAllSegments(ByVal p_trans As Transaction, Optional ByVal p_nooffr As Boolean = True) As SelectionFilter
        Dim lg As LayerGroup = CLDS_LayerGroup()
        If lg Is Nothing Then
            Return CLDS_FilterAllSegments()
        Else
            Dim tvl As New System.Collections.Generic.List(Of TypedValue)(lg.LayerIds.Count + 6)
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<and"))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<or"))
            For Each lObj As ObjectId In lg.LayerIds
                If lObj.IsValid And Not (lObj.IsErased Or lObj.IsEffectivelyErased Or lObj.IsNull) Then
                    Dim ltr As LayerTableRecord = TryCast(p_trans.GetObject(lObj, OpenMode.ForRead), LayerTableRecord)
                    If Not ltr Is Nothing Then
                        If Not ((ltr.Name = pPrefs.l_offr And p_nooffr) Or _
                                ltr.Name = pPrefs.l_warn Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_warn) + 1) = pPrefs.l_warn & "_" Or _
                                ltr.Name = pPrefs.l_eror Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_eror) + 1) = pPrefs.l_eror & "_" Or _
                                ltr.Name = pPrefs.l_hlit Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_hlit) + 1) = pPrefs.l_hlit & "_" Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_crte) + 1) = pPrefs.l_crte & "_" Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_arte) + 1) = pPrefs.l_arte & "_") Then
                            tvl.Add(New TypedValue(CInt(DxfCode.LayerName), ltr.Name))
                        End If
                    End If
                End If
            Next
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "or>"))
            tvl.Add(New TypedValue(DxfCode.Start, "LINE"))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "and>"))
            Dim lsf As SelectionFilter = New SelectionFilter(tvl.ToArray())
            Return lsf
        End If
    End Function
    Public Function CLDS_FilterPendingSegments() As SelectionFilter
        Dim ltvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_isrt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_updt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_dele), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_brek), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "LINE"), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim lsf As SelectionFilter = New SelectionFilter(ltvs)
        Return lsf
    End Function
    Public Function CLDS_FilterValidateSegments() As SelectionFilter
        Dim ltvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_jump), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_sgmt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_used), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_appd), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_isrt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_updt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_brek), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "LINE"), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim lsf As SelectionFilter = New SelectionFilter(ltvs)
        Return lsf
    End Function
    Public Function CLDS_XFilterValidateSegments(ByVal p_trans As Transaction) As SelectionFilter
        Dim lg As LayerGroup = CLDS_LayerGroup()
        If lg Is Nothing Then
            Return CLDS_FilterAllSegments()
        Else
            Dim tvl As New System.Collections.Generic.List(Of TypedValue)(lg.LayerIds.Count + 6)
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<and"))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<or"))
            For Each lObj As ObjectId In lg.LayerIds
                If lObj.IsValid And Not (lObj.IsErased Or lObj.IsEffectivelyErased Or lObj.IsNull) Then
                    Dim ltr As LayerTableRecord = TryCast(p_trans.GetObject(lObj, OpenMode.ForRead), LayerTableRecord)
                    If Not ltr Is Nothing Then
                        If Not (ltr.Name = pPrefs.l_dele Or _
                                ltr.Name = pPrefs.l_warn Or _
                                ltr.Name = pPrefs.l_eror Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_hlit) + 1) = pPrefs.l_hlit & "_" Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_crte) + 1) = pPrefs.l_crte & "_" Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_arte) + 1) = pPrefs.l_arte & "_") Then
                            tvl.Add(New TypedValue(CInt(DxfCode.LayerName), ltr.Name))
                        End If
                    End If
                End If
            Next
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "or>"))
            tvl.Add(New TypedValue(DxfCode.Start, "LINE"))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "and>"))
            Dim lsf As SelectionFilter = New SelectionFilter(tvl.ToArray())
            Return lsf
        End If
    End Function
    Public Function CLDS_SelectSegments(ByVal p_ed As Editor) As PromptSelectionResult
        Dim lsf As SelectionFilter = CLDS_FilterSegments()
        Return p_ed.SelectAll(lsf)
    End Function
    Public Function CLDS_SelectAllSegments(ByVal p_ed As Editor) As PromptSelectionResult
        Dim lsf As SelectionFilter = CLDS_FilterAllSegments()
        Return p_ed.SelectAll(lsf)
    End Function
    Public Function CLDS_XSelectAllSegments(ByVal p_trans As Transaction, ByVal p_ed As Editor, Optional ByVal p_nooffr As Boolean = True) As PromptSelectionResult
        Dim lsf As SelectionFilter = CLDS_XFilterAllSegments(p_trans, p_nooffr)
        Return p_ed.SelectAll(lsf)
    End Function
    Public Function CLDS_SelectPendingSegments(ByVal p_ed As Editor) As PromptSelectionResult
        Dim lsf As SelectionFilter = CLDS_FilterPendingSegments()
        Return p_ed.SelectAll(lsf)
    End Function
    Public Function CLDS_SelectValidateSegments(ByVal p_ed As Editor) As PromptSelectionResult
        Dim lsf As SelectionFilter = CLDS_FilterValidateSegments()
        Return p_ed.SelectAll(lsf)
    End Function
    Public Function CLDS_XSelectValidateSegments(ByVal p_trans As Transaction, ByVal p_ed As Editor) As PromptSelectionResult
        Dim lsf As SelectionFilter = CLDS_XFilterValidateSegments(p_trans)
        Return p_ed.SelectAll(lsf)
    End Function
    Public Function CLDS_FilterDevices() As SelectionFilter
        Dim ntvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.LayerName, pPrefs.l_dvce), _
            New TypedValue(DxfCode.Start, "INSERT"), _
            New TypedValue(DxfCode.BlockName, pPrefs.b_dvce)}
        Dim nsf As SelectionFilter = New SelectionFilter(ntvs)
        Return nsf
    End Function
    Public Function CLDS_FilterAllDevices() As SelectionFilter
        Dim ntvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_dvce), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_isrt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_updt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_dele), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "INSERT"), _
                New TypedValue(DxfCode.BlockName, pPrefs.b_dvce), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim nsf As SelectionFilter = New SelectionFilter(ntvs)
        Return nsf
    End Function
    Public Function CLDS_XFilterAllDevices(ByVal p_trans As Transaction) As SelectionFilter
        Dim lg As LayerGroup = CLDS_LayerGroup()
        If lg Is Nothing Then
            Return CLDS_FilterAllDevices()
        Else
            Dim tvl As New System.Collections.Generic.List(Of TypedValue)(lg.LayerIds.Count + 6)
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<and"))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<or"))
            For Each lObj As ObjectId In lg.LayerIds
                If lObj.IsValid And Not (lObj.IsErased Or lObj.IsEffectivelyErased Or lObj.IsNull) Then
                    Dim ltr As LayerTableRecord = TryCast(p_trans.GetObject(lObj, OpenMode.ForRead), LayerTableRecord)
                    If Not ltr Is Nothing Then
                        If Not (ltr.Name = pPrefs.l_warn Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_warn) + 1) = pPrefs.l_warn & "_" Or _
                                ltr.Name = pPrefs.l_eror Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_eror) + 1) = pPrefs.l_eror & "_" Or _
                                ltr.Name = pPrefs.l_hlit Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_hlit) + 1) = pPrefs.l_hlit & "_") Then
                            tvl.Add(New TypedValue(CInt(DxfCode.LayerName), ltr.Name))
                        End If
                    End If
                End If
            Next
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "or>"))
            tvl.Add(New TypedValue(DxfCode.Start, "INSERT"))
            tvl.Add(New TypedValue(DxfCode.BlockName, pPrefs.b_dvce))
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "and>"))
            Dim nsf As SelectionFilter = New SelectionFilter(tvl.ToArray())
            Return nsf
        End If
    End Function
    Public Function CLDS_FilterPendingDevices() As SelectionFilter
        Dim ntvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_isrt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_updt), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_dele), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Start, "INSERT"), _
                New TypedValue(DxfCode.BlockName, pPrefs.b_dvce), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim nsf As SelectionFilter = New SelectionFilter(ntvs)
        Return nsf
    End Function
    Public Function CLDS_SelectDevices(ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_FilterDevices()
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_SelectAllDevices(ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_FilterAllDevices()
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_XSelectAllDevices(ByVal p_trans As Transaction, ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_XFilterAllDevices(p_trans)
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_SelectPendingDevices(ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_FilterPendingDevices()
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_FilterHighlights() As SelectionFilter
        Dim ntvs() As TypedValue = New TypedValue() _
            {New TypedValue(DxfCode.Operator, "<and"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_hlit & "_RN"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_hlit & "_RS"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_hlit & "_PN"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_hlit & "_PS"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_hlit & "_FD"), _
                    New TypedValue(DxfCode.LayerName, pPrefs.l_hlit & "_TD"), _
                New TypedValue(DxfCode.Operator, "or>"), _
                New TypedValue(DxfCode.Operator, "<or"), _
                    New TypedValue(DxfCode.Operator, "<and"), _
                        New TypedValue(DxfCode.Start, "INSERT"), _
                        New TypedValue(DxfCode.BlockName, pPrefs.b_node), _
                    New TypedValue(DxfCode.Operator, "and>"), _
                    New TypedValue(DxfCode.Operator, "<and"), _
                        New TypedValue(DxfCode.Start, "INSERT"), _
                        New TypedValue(DxfCode.BlockName, pPrefs.b_nodm), _
                    New TypedValue(DxfCode.Operator, "and>"), _
                    New TypedValue(DxfCode.Operator, "<and"), _
                        New TypedValue(DxfCode.Start, "INSERT"), _
                        New TypedValue(DxfCode.BlockName, pPrefs.b_dvce), _
                    New TypedValue(DxfCode.Operator, "and>"), _
                    New TypedValue(DxfCode.Start, "LINE"), _
                New TypedValue(DxfCode.Operator, "or>"), _
            New TypedValue(DxfCode.Operator, "and>")}
        Dim nsf As SelectionFilter = New SelectionFilter(ntvs)
        Return nsf
    End Function
    Public Function CLDS_SelectHighlights(ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_FilterHighlights()
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_XFilterErrors(ByVal p_trans As Transaction) As SelectionFilter
        Dim lg As LayerGroup = CLDS_LayerGroup()
        If lg Is Nothing Then
            Return Nothing
        Else
            Dim tvl As New System.Collections.Generic.List(Of TypedValue)(lg.LayerIds.Count + 2)
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<or"))
            For Each lObj As ObjectId In lg.LayerIds
                If lObj.IsValid And Not (lObj.IsErased Or lObj.IsEffectivelyErased Or lObj.IsNull) Then
                    Dim ltr As LayerTableRecord = TryCast(p_trans.GetObject(lObj, OpenMode.ForRead), LayerTableRecord)
                    If Not ltr Is Nothing Then
                        If (Mid$(ltr.Name, 1, Len(pPrefs.l_warn) + 1) = pPrefs.l_warn & "_" Or _
                                Mid$(ltr.Name, 1, Len(pPrefs.l_eror) + 1) = pPrefs.l_eror & "_") Then
                            tvl.Add(New TypedValue(CInt(DxfCode.LayerName), ltr.Name))
                        End If
                    End If
                End If
            Next
            tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "or>"))
            Dim nsf As SelectionFilter = New SelectionFilter(tvl.ToArray())
            Return nsf
        End If
    End Function
    Public Function CLDS_XSelectErrors(ByVal p_trans As Transaction, ByVal p_ed As Editor) As PromptSelectionResult
        Dim nsf As SelectionFilter = CLDS_XFilterErrors(p_trans)
        If nsf Is Nothing Then
            Return Nothing
        End If
        Return p_ed.SelectAll(nsf)
    End Function
    Public Function CLDS_IsDevice(ByVal ntrans As Transaction, ByVal p_obj As ObjectId) As BlockReference
        Dim cn As String = UCase(p_obj.ObjectClass.Name)
        If cn = "ACDBBLOCKREFERENCE" Then
            Dim devB As BlockReference
            Dim dID As String
            devB = DirectCast(p_obj.GetObject(OpenMode.ForRead), BlockReference)
            dID = CLDS_GetBlockAttr(devB, pPrefs.t_dvce)
            If (devB.Name <> pPrefs.b_node And devB.Name <> pPrefs.b_nodm) Or dID = "" Then
                Return Nothing
            Else
                Return devB
            End If
        Else
            Return Nothing
        End If
    End Function
    Public Function CLDS_IsNode(ByVal ntrans As Transaction, ByVal p_obj As ObjectId) As BlockReference
        Dim cn As String = UCase(p_obj.ObjectClass.Name)
        If cn = "ACDBBLOCKREFERENCE" Then
            Dim nodeB As BlockReference
            Dim dID As String
            nodeB = DirectCast(p_obj.GetObject(OpenMode.ForRead), BlockReference)
            dID = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
            If (nodeB.Name <> pPrefs.b_node And nodeB.Name <> pPrefs.b_nodm) Or dID = "" Then
                Return Nothing
            Else
                Return nodeB
            End If
        Else
            Return Nothing
        End If
    End Function
    Public Function CLDS_IsSegment(ByVal ntrans As Transaction, ByVal p_obj As ObjectId) As ResultBuffer
        Dim cn As String = UCase(p_obj.ObjectClass.Name)
        If cn = "ACDBLINE" Then
            Dim lineE As Line = DirectCast(p_obj.GetObject(OpenMode.ForRead), Line)
            Dim rb As ResultBuffer
            rb = CLDS_GetXRecord(ntrans, lineE)
            If rb Is Nothing Then
                Return Nothing
            End If
            Dim ra As TypedValue() = rb.AsArray
            Dim o_fnode As String = ra(0).Value
            Dim o_tnode As String = ra(1).Value
            Dim st As String = ra(2).Value
            If o_fnode = "" Or o_tnode = "" Or st = pPrefs.n_offr Then
                Return Nothing
            Else
                Return rb
            End If
        Else
            Return Nothing
        End If
    End Function
    Public Sub CLDS_PickNode(ByRef o_nid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        o_nid = ""
        Dim slObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    ed.WriteMessage(vbCrLf & "Too many entities selected")
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If slObj.IsNull Then
            Dim peo As New PromptEntityOptions(vbLf & "Select node block:")
            peo.SetRejectMessage("Node block selection required." & vbCrLf)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                slObj = per.ObjectId
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                Exit Sub
            End If
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim cn As String = UCase(slObj.ObjectClass.Name)
                ed.WriteMessage(vbCrLf & "Picked: " & cn)
                If cn = "ACDBBLOCKREFERENCE" Then
                    Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                    Dim dID As String = CLDS_GetBlockAttr(nodeB, "NODE")
                    If (nodeB.Name <> pPrefs.b_node And nodeB.Name <> pPrefs.b_nodm) Or dID = "" Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected block is not a CMPIC node")
                        Exit Sub
                    Else
                        o_nid = dID
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Node " & o_nid)
                    End If
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Invalid selection")
                End If
            End Using
        End Using
    End Sub
    Public Sub CLDS_PickTwoNodes(ByRef o_nid1 As String, ByRef o_nid2 As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        o_nid1 = ""
        o_nid2 = ""
        Dim slObj(2) As ObjectId
        slObj(0) = ObjectId.Null
        slObj(1) = ObjectId.Null
        Dim onid(2) As String
        onid(0) = ""
        onid(1) = ""
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 0 Then
                    Exit Sub
                ElseIf sobj.GetLength(0) = 1 Then
                    slObj(0) = sobj(0)
                ElseIf sobj.GetLength(0) = 2 Then
                    slObj(0) = sobj(0)
                    slObj(1) = sobj(1)
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Too many entities selected")
                    Exit Sub
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        Dim j As Integer = -1
        Using acLckDoc As DocumentLock = doc.LockDocument()
            For i As Integer = 0 To 2
                If Not slObj(i).IsNull Then
                    Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                        Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                        Dim cn As String = UCase(slObj(i).ObjectClass.Name)
                        If cn = "ACDBBLOCKREFERENCE" Then
                            Dim nodeB As BlockReference = DirectCast(slObj(i).GetObject(OpenMode.ForRead), BlockReference)
                            Dim dID As String = CLDS_GetBlockAttr(nodeB, "NODE")
                            If (nodeB.Name = pPrefs.b_node Or nodeB.Name = pPrefs.b_nodm) And dID <> "" Then
                                j = j + 1
                                onid(j) = dID
                                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Node " & onid(i))
                            End If
                        End If
                        nTrans.Commit()
                    End Using
                End If
            Next
        End Using
        o_nid1 = onid(0)
        o_nid2 = onid(1)
    End Sub
    Public Sub CLDS_PickOneNode(ByRef o_nid1 As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        o_nid1 = ""
        Dim slObj As ObjectId = ObjectId.Null
        Dim onid As String = ""
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 0 Then
                    Exit Sub
                ElseIf sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    'CLDS_Static_Utils.CLDS_WriteMessage(ed, "Too many entities selected")
                    Exit Sub
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If Not slObj.IsNull Then
            Using acLckDoc As DocumentLock = doc.LockDocument()
                Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                    Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                    Dim cn As String = UCase(slObj.ObjectClass.Name)
                    If cn = "ACDBBLOCKREFERENCE" Then
                        Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                        Dim dID As String = CLDS_GetBlockAttr(nodeB, "NODE")
                        If (nodeB.Name = pPrefs.b_node Or nodeB.Name = pPrefs.b_nodm) And dID <> "" Then
                            onid = dID
                            'CLDS_Static_Utils.CLDS_WriteMessage(ed, "Node " & onid)
                        End If
                    End If
                    nTrans.Commit()
                End Using
            End Using
        End If
        o_nid1 = onid
    End Sub
    Public Sub CLDS_PickDeviceNode(ByRef o_did As String, ByRef o_nid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        o_did = ""
        o_nid = ""
        Dim slObj(2) As ObjectId
        slObj(0) = ObjectId.Null
        slObj(1) = ObjectId.Null
        Dim onid(2) As String
        onid(0) = ""
        onid(1) = ""
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 0 Then
                    Exit Sub
                ElseIf sobj.GetLength(0) = 1 Then
                    slObj(0) = sobj(0)
                ElseIf sobj.GetLength(0) = 2 Then
                    slObj(0) = sobj(0)
                    slObj(1) = sobj(1)
                Else
                    'CLDS_Static_Utils.CLDS_WriteMessage(ed, "Too many entities selected")
                    Exit Sub
                End If
                'Dim nobj() As ObjectId
                'ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        Using acLckDoc As DocumentLock = doc.LockDocument()
            For i As Integer = 0 To 2
                If Not slObj(i).IsNull Then
                    Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                        Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                        Dim cn As String = UCase(slObj(i).ObjectClass.Name)
                        If cn = "ACDBBLOCKREFERENCE" Then
                            Dim nodeB As BlockReference = DirectCast(slObj(i).GetObject(OpenMode.ForRead), BlockReference)
                            Dim nID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
                            Dim dID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_dvce)
                            If nodeB.Name = pPrefs.b_dvce And dID <> "" Then
                                If onid(0) <> "" Then
                                    Exit Sub
                                End If
                                onid(0) = dID
                            End If
                            If (nodeB.Name = pPrefs.b_node Or nodeB.Name = pPrefs.b_nodm) And nID <> "" Then
                                If onid(1) <> "" Then
                                    Exit Sub
                                End If
                                onid(1) = nID
                            End If
                        End If
                        nTrans.Commit()
                    End Using
                End If
            Next
        End Using
        o_did = onid(0)
        o_nid = onid(1)
    End Sub
    Public Function CLDS_PickNodeBlock(Optional ByVal p_empty As Boolean = False) As BlockReference
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim o_nid As String
        Dim slObj As ObjectId = ObjectId.Null
        CLDS_PickNodeBlock = Nothing
        Dim sObjL As System.Collections.Generic.List(Of ObjectId) = New System.Collections.Generic.List(Of ObjectId)
        If p_empty Then
            Dim nobj() As ObjectId
            ed.SetImpliedSelection(nobj)
        Else
            Try
                Dim psr As PromptSelectionResult = ed.SelectImplied
                If psr.Status = PromptStatus.OK Then
                    Dim sobj() As ObjectId = psr.Value.GetObjectIds
                    For Each xObj As ObjectId In sobj
                        sObjL.Add(xObj)
                    Next
                    'If sobj.GetLength(0) = 1 Then
                    'slObj = sobj(0)
                    'Else
                    'ed.WriteMessage(vbCrLf & "Too many entities selected")
                    'End If
                    'Dim nobj() As ObjectId
                    'ed.SetImpliedSelection(nobj)
                End If
            Catch ex As Exception

            End Try
        End If
        Dim nodeB As BlockReference = Nothing
        Dim picking As Boolean = True
        Dim peo As New PromptEntityOptions(vbLf & "Select node block:")
        peo.SetRejectMessage("Node block selection required." & vbCrLf)
        peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
        While picking
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                slObj = per.ObjectId
                Using acLckDoc As DocumentLock = doc.LockDocument()
                    Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                        Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                        Dim cn As String = UCase(slObj.ObjectClass.Name)
                        ed.WriteMessage(vbCrLf & "Picked: " & cn)
                        If cn = "ACDBBLOCKREFERENCE" Then
                            nodeB = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                            Dim dID As String = CLDS_GetBlockAttr(nodeB, "NODE")
                            If (nodeB.Name <> pPrefs.b_node And nodeB.Name <> pPrefs.b_nodm) Or dID = "" Then
                                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected block is not a CMPIC node")
                                nodeB = Nothing
                            Else
                                o_nid = dID
                                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Node " & o_nid)
                                CLDS_PickNodeBlock = nodeB
                                sObjL.Add(slObj)
                                ed.SetImpliedSelection(sObjL.ToArray)
                                picking = False
                            End If
                        Else
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Invalid selection")
                        End If
                    End Using
                End Using
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                picking = False
            End If
        End While
        Return nodeB
    End Function
    Public Sub CLDS_PickSegment(ByRef o_fnode As String, ByRef o_tnode As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        o_fnode = ""
        o_tnode = ""
        Dim slObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    ed.WriteMessage(vbCrLf & "Too many entities selected" & vbCrLf)
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If slObj.IsNull Then
            Dim peo As New PromptEntityOptions(vbCrLf & "Select segment line:")
            peo.SetRejectMessage("Line or node block selection required." & vbCrLf)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Line), False)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                slObj = per.ObjectId
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                Exit Sub
            End If
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim cn As String = UCase(slObj.ObjectClass.Name)
                ed.WriteMessage(vbCrLf & "Picked: " & cn)
                If cn = "ACDBLINE" Then
                    Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                    Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                    If rb Is Nothing Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected line is not a CMPIC segment")
                        Exit Sub
                    End If
                    Dim ra As TypedValue() = rb.AsArray
                    Dim st As String = ra(2).Value
                    If st = pPrefs.n_offr Then
                        o_fnode = ""
                        o_tnode = ""
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Off-route lengths are not real segments, and cannot be selected")
                    Else
                        o_fnode = ra(0).Value
                        o_tnode = ra(1).Value
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment " & o_fnode & ":" & o_tnode)
                    End If
                ElseIf cn = "ACDBBLOCKREFERENCE" Then
                    Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                    Dim nID As String = CLDS_GetBlockAttr(nodeB, "NODE")
                    Dim nType As String = CLDS_GetBlockAttr(nodeB, "TYPE")
                    If nID = "" Or nType = "" Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected block is not a CMPIC point-segment")
                        Exit Sub
                    Else
                        o_fnode = nID
                        o_tnode = nID
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Point-segment " & o_fnode)
                    End If
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Invalid selection")
                End If
            End Using
        End Using
    End Sub
    Public Function CLDS_PickedSegment() As String
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim slObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    Return ""
                End If
            End If
        Catch ex As Exception
            Return ""
        End Try
        If slObj.IsNull Then
            Return ""
        End If
        Dim segid As String = ""
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim cn As String = UCase(slObj.ObjectClass.Name)
                If cn = "ACDBLINE" Then
                    Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                    Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                    If rb Is Nothing Then
                        segid = ""
                    Else
                        Dim ra As TypedValue() = rb.AsArray
                        Dim st As String = ra(2).Value
                        If st = pPrefs.n_offr Then
                            segid = ""
                        Else
                            segid = ra(5).Value
                        End If
                    End If
                ElseIf cn = "ACDBBLOCKREFERENCE" Then
                    Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                    Dim nID As String = CLDS_GetBlockAttr(nodeB, "NODE")
                    Dim nType As String = CLDS_GetBlockAttr(nodeB, "TYPE")
                    If nID = "" Or nType = "" Then
                        segid = ""
                    Else
                        segid = nID
                    End If
                Else
                    segid = ""
                End If
            End Using
        End Using
        Return segid
    End Function
    Public Function CLDS_PickSegmentObject() As ObjectId
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        CLDS_PickSegmentObject = Nothing
        Dim o_fnode As String = ""
        Dim o_tnode As String = ""
        Dim slObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Too many entities selected")
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If slObj.IsNull Then
            Dim peo As New PromptEntityOptions(vbLf & "Select segment line:")
            peo.SetRejectMessage("Line or node block selection required." & vbCrLf)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Line), False)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                slObj = per.ObjectId
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                Exit Function
            End If
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim cn As String = UCase(slObj.ObjectClass.Name)
                ed.WriteMessage(vbCrLf & "Picked: " & cn)
                If cn = "ACDBLINE" Then
                    Dim lineE As Line = DirectCast(slObj.GetObject(OpenMode.ForRead), Line)
                    Dim rb As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                    If rb Is Nothing Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected line is not a CMPIC segment")
                        Exit Function
                    End If
                    Dim ra As TypedValue() = rb.AsArray
                    Dim st As String = ra(2).Value
                    If st = pPrefs.n_offr Then
                        o_fnode = ""
                        o_tnode = ""
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Off-route lengths are not real segments, and cannot be selected")
                        CLDS_PickSegmentObject = Nothing
                    Else
                        o_fnode = ra(0).Value
                        o_tnode = ra(1).Value
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Segment " & o_fnode & ":" & o_tnode & vbLf)
                        CLDS_PickSegmentObject = slObj
                    End If
                ElseIf cn = "ACDBBLOCKREFERENCE" Then
                    Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                    If nodeB.Name = pPrefs.b_node Or nodeB.Name = pPrefs.b_nodm Then
                        Dim nID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_node)
                        Dim nType As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_type)
                        If nID = "" Then
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected block is not a CMPIC point-segment")
                            Exit Function
                        ElseIf nType = "" Then
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Node " & nID)
                            CLDS_PickSegmentObject = slObj
                        Else
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Point-segment " & nID)
                            CLDS_PickSegmentObject = slObj
                        End If
                    ElseIf nodeB.Name = pPrefs.b_dvce Then
                        Dim nID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_dvce)
                        If nID = "" Then
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected block is not a CMPIC device")
                            Exit Function
                        Else
                            CLDS_Static_Utils.CLDS_WriteMessage(ed, "Device " & nID)
                            CLDS_PickSegmentObject = slObj
                        End If
                    End If
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Invalid selection")
                End If
            End Using
        End Using
    End Function
    Public Sub CLDS_PickDevice(ByRef o_devid As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        o_devid = ""
        Dim slObj As ObjectId = ObjectId.Null
        Try
            Dim psr As PromptSelectionResult = ed.SelectImplied
            If psr.Status = PromptStatus.OK Then
                Dim sobj() As ObjectId = psr.Value.GetObjectIds
                If sobj.GetLength(0) = 1 Then
                    slObj = sobj(0)
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Too many entities selected")
                End If
                Dim nobj() As ObjectId
                ed.SetImpliedSelection(nobj)
            End If
        Catch ex As Exception

        End Try
        If slObj.IsNull Then
            Dim peo As New PromptEntityOptions(vbLf & "Select device block:")
            peo.SetRejectMessage("Device block selection required." & vbCrLf)
            peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status = PromptStatus.OK Then
                slObj = per.ObjectId
            Else
                CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selection cancelled")
                Exit Sub
            End If
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                Dim cn As String = UCase(slObj.ObjectClass.Name)
                ed.WriteMessage(vbCrLf & "Picked: " & cn)
                If cn = "ACDBBLOCKREFERENCE" Then
                    Dim nodeB As BlockReference = DirectCast(slObj.GetObject(OpenMode.ForRead), BlockReference)
                    Dim dID As String = CLDS_GetBlockAttr(nodeB, pPrefs.t_dvce)
                    If dID = "" Then
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Selected block is not a CMPIC device")
                        Exit Sub
                    Else
                        o_devid = dID
                        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Device " & o_devid)
                    End If
                Else
                    CLDS_Static_Utils.CLDS_WriteMessage(ed, "Invalid selection")
                End If
            End Using
        End Using
    End Sub
    Public Sub CLDS_SelectSegment(ByVal p_fn As String, ByVal p_tn As String, Optional ByVal p_zoom As Boolean = True)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim nobj() As ObjectId
        ed.SetImpliedSelection(nobj)
        If p_fn = "" Or p_tn = "" Then
            Exit Sub
        End If
        CancelPrior()
        If p_fn = p_tn Then
            CLDS_SelectNode(p_fn, "", True)
            Exit Sub
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                Dim sObj As ObjectId = CLDS_FindSegment(dTrans, nd, p_fn, p_tn, 2)
                If Not sObj.IsNull Then
                    If p_zoom Then
                        Dim ent As Entity = DirectCast(dTrans.GetObject(sObj, OpenMode.ForRead), Entity)
                        CLDS_Static_Utils.ZoomToEntity(ed, ent)
                    End If
                    Dim xobj As ObjectId() = New ObjectId() {sObj}
                    ed.SetImpliedSelection(xobj)
                End If
                dTrans.Commit()
            End Using
        End Using
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_SelectNode(ByVal p_id As String, Optional ByVal p_devid As String = "", Optional ByVal p_zoom As Boolean = False)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim zobj() As ObjectId
        ed.SetImpliedSelection(zobj)
        If p_id = "" And p_devid = "" Then
            Exit Sub
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                Dim nObj As ObjectId, dObj As ObjectId
                Dim xobj As ObjectId()
                If p_id = "" Then
                    nObj = ObjectId.Null
                Else
                    nObj = CLDS_FindNode(dTrans, nd, p_id)
                End If
                If p_devid = "" Then
                    dObj = ObjectId.Null
                Else
                    dObj = CLDS_FindNode(dTrans, nd, p_devid)
                End If
                If Not nObj.IsNull Then
                    If dObj.IsNull Then
                        xobj = New ObjectId() {nObj}
                        ed.SetImpliedSelection(xobj)
                    Else
                        xobj = New ObjectId() {nObj, dObj}
                        ed.SetImpliedSelection(xobj)
                    End If
                Else
                    If Not dObj.IsNull Then
                        xobj = New ObjectId() {dObj}
                        ed.SetImpliedSelection(xobj)
                    End If
                End If
                If p_zoom Then
                    If Not nObj.IsNull Then
                        CLDS_Static_Utils.ZoomToObject(dTrans, nObj)
                    ElseIf Not dObj.IsNull Then
                        CLDS_Static_Utils.ZoomToObject(dTrans, dObj)
                    End If
                End If
                dTrans.Commit()
            End Using
        End Using
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_HiliteNode(ByVal p_id As String, ByVal p_type As String)
        If p_id = "" Then
            Exit Sub
        End If
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim cUCSM As Matrix3d = ed.CurrentUserCoordinateSystem
        Dim cUCS As CoordinateSystem3d = cUCSM.CoordinateSystem3d
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim bt As BlockTable = DirectCast(dTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(dTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                Dim nObj As ObjectId
                If p_id = "" Then
                    nObj = ObjectId.Null
                Else
                    nObj = CLDS_FindNode(dTrans, nd, p_id)
                End If
                Dim nRotate As Double = (pPrefs.a_node / 180.0) * 3.1415926538
                If Not nObj.IsNull Then
                    Dim nodeB As BlockReference = TryCast(dTrans.GetObject(nObj, OpenMode.ForWrite), BlockReference)
                    If Not nodeB Is Nothing Then
                        Dim nodeO As ObjectId = CLDS_FindBlock(bt, doc, nodeB.Name)
                        Dim xp As Point3d = nodeB.Position
                        Dim br As New BlockReference(xp, nodeO)
                        Dim bl As String = pPrefs.l_hlit & "_" & p_type
                        Dim cl As Color
                        Select Case p_type
                            Case "RN"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_rnod)
                            Case "RS"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_rnod)
                            Case "PN"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_pnod)
                            Case "PS"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_pnod)
                            Case "FD"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_fdev)
                            Case "TD"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_tdev)
                            Case Else
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.c_warn)
                        End Select
                        CLDS_CheckLayer(dTrans, doc, bl, cl)
                        CLDS_SetLayer(br, bl, "Node highlight")
                        'br.Layer = bl
                        br.TransformBy(Matrix3d.Scaling(pPrefs.f_node, xp))
                        br.TransformBy(Matrix3d.Rotation(nRotate, cUCS.Zaxis, xp))
                        btr.AppendEntity(br)
                        dTrans.AddNewlyCreatedDBObject(br, True)
                        CLDS_CloneBlock(dTrans, doc, nodeB.Name, nodeO, br)
                        If nodeB.Name = pPrefs.b_node Or nodeB.Name = pPrefs.b_nodm Then
                            CLDS_SetBlockAttr(br, pPrefs.t_node, CLDS_GetBlockAttr(nodeB, pPrefs.t_node))
                            CLDS_SetBlockAttr(br, pPrefs.t_type, CLDS_GetBlockAttr(nodeB, pPrefs.t_type))
                            CLDS_SetBlockAttr(br, pPrefs.t_area, CLDS_GetBlockAttr(nodeB, pPrefs.t_area))
                            CLDS_SetBlockAttr(br, pPrefs.t_seg, CLDS_GetBlockAttr(nodeB, pPrefs.t_seg))
                        Else
                            CLDS_SetBlockAttr(br, pPrefs.t_dvce, CLDS_GetBlockAttr(nodeB, pPrefs.t_dvce))
                            CLDS_SetBlockAttr(br, pPrefs.t_area, CLDS_GetBlockAttr(nodeB, pPrefs.t_area))
                        End If
                    End If
                End If
                dTrans.Commit()
            End Using
        End Using
        Application.UpdateScreen()
    End Sub
    Public Sub CLDS_HiliteSegment(ByVal p_from As String, ByVal p_to As String, ByVal p_type As String)
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        If p_from = "" Or p_to = "" Then
            Exit Sub
        End If
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using dTrans As Transaction = doc.TransactionManager.StartTransaction
                Dim bt As BlockTable = DirectCast(dTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(dTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                Dim nd As DBDictionary = CLDS_GetDictionary(doc.Database, dTrans, False)
                Dim n1Obj As ObjectId, n2Obj As ObjectId
                n1Obj = CLDS_FindNode(dTrans, nd, p_from)
                n2Obj = CLDS_FindNode(dTrans, nd, p_to)
                If Not (n1Obj.IsNull Or n2Obj.IsNull) Then
                    Dim n1B As BlockReference = TryCast(dTrans.GetObject(n1Obj, OpenMode.ForWrite), BlockReference)
                    Dim n2B As BlockReference = TryCast(dTrans.GetObject(n2Obj, OpenMode.ForWrite), BlockReference)
                    If Not (n1B Is Nothing Or n2B Is Nothing) Then
                        Dim bl As String = pPrefs.l_hlit & "_" & p_type
                        Dim lineE As Line = New Line(n1B.Position, n2B.Position)
                        Dim cl As Color
                        Select Case p_type
                            Case "RS"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_rnod)
                            Case "PS"
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.h_pnod)
                            Case Else
                                cl = Autodesk.AutoCAD.Colors.Color.FromColor(pPrefs.c_warn)
                        End Select
                        CLDS_CheckLayer(dTrans, doc, bl, cl)
                        CLDS_SetLayer(lineE, bl, "Segment highlight")
                        'lineE.Layer = bl
                        btr.AppendEntity(lineE)
                        dTrans.AddNewlyCreatedDBObject(lineE, True)
                    End If
                End If
                dTrans.Commit()
            End Using
        End Using
        Application.UpdateScreen()
    End Sub
#End Region
#Region "Find/Replace"
    Public Sub CLDS_FindReplace(ByVal p_dialog As CLDS_Connection_Container, ByVal p_find As String, ByVal p_replace As String)
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim npsr As PromptSelectionResult, lpsr As PromptSelectionResult, dpsr As PromptSelectionResult

        Dim e As Boolean = True

        Dim iRNodeID As Integer = 0
        Dim iRNodeArea As Integer = 0
        Dim iRDevID As Integer = 0
        Dim iRDevArea As Integer = 0
        Dim iRSegID As Integer = 0
        Dim iRSegRwID As Integer = 0
        Dim iRSegType As Integer = 0
        Dim iRSegSeg As Integer = 0

        p_dialog.txRNodeID.Text = ""
        p_dialog.txRNodeArea.Text = ""
        p_dialog.txRDevID.Text = ""
        p_dialog.txRDevArea.Text = ""
        p_dialog.txRSegID.Text = ""
        p_dialog.txRSegRwID.Text = ""
        p_dialog.txRSegType.Text = ""
        p_dialog.txRSegSeg.Text = ""
        p_dialog.gbReplace.Update()

        If p_find = "" Then
            Exit Sub
        End If
        Dim v_replace As String = p_replace
        If v_replace = p_find Then
            v_replace = ""
        End If

        Dim cc As Integer = 0

        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                npsr = CLDS_XSelectAllNodes(nTrans, ed)
                Dim v_nooffr As Boolean = True
                'If (p_dialog.cxRNodeID.Checked And p_dialog.cxRDevID.Checked) Then
                If p_dialog.cxRNearNode.Checked Then
                    v_nooffr = False
                End If
                lpsr = CLDS_XSelectAllSegments(nTrans, ed, v_nooffr)
                dpsr = CLDS_XSelectAllDevices(nTrans, ed)
                If Not npsr.Value Is Nothing Then
                    p_dialog.pbFind.Minimum = 0
                    p_dialog.pbFind.Maximum = npsr.Value.Count
                    p_dialog.pbFind.Value = 0
                    p_dialog.pbFind.Visible = True
                    Dim nc As Integer
                    Dim nn As Integer = 0
                    For Each nodeID As ObjectId In npsr.Value.GetObjectIds
                        nn += 1
                        p_dialog.pbFind.Value = nn
                        Dim nodeE As BlockReference = DirectCast(nodeID.GetObject(OpenMode.ForRead), BlockReference)
                        Dim nID As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_node)
                        Dim nType As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_type)
                        Dim nArea As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_area)
                        Dim nSeg As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_seg)
                        If nType = pPrefs.n_jump Then
                            nSeg = ""
                        End If
                        Dim sID As String = ""
                        Dim nLen As String = pPrefs.x_psln
                        Dim nRWay As String = ""
                        Dim nMajor As String = "-"
                        Dim r1 As ResultBuffer = CLDS_GetXRecord(nTrans, nodeE)
                        If Not r1 Is Nothing Then
                            Dim t1 As TypedValue() = r1.AsArray
                            nLen = t1(4).Value
                            If t1.Length > 5 Then
                                sID = t1(5).Value
                            End If
                            If t1.Length > 6 Then
                                nRWay = t1(6).Value
                            End If
                            If t1.Length > 7 Then
                                nMajor = t1(7).Value
                            End If
                        End If
                        Dim nLayer As String = nodeE.Layer
                        nc = 0
                        If p_dialog.cxRNodeID.Checked And nLayer <> pPrefs.l_dele And InStr(nID, p_find) > 0 Then
                            iRNodeID += 1
                            p_dialog.txRNodeID.Text = Trim(Str$(iRNodeID))
                            p_dialog.txRNodeID.Update()
                            If v_replace <> "" Then
                                Dim xID As String = Replace(nID, p_find, v_replace, 1, -1, CompareMethod.Text)
                                e = CLDS_RenameEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Node_Key(nID, nRule), CLDS_Static_Utils.CLDS_Node_Key(xID, nRule))
                                If Not e Then
                                    MsgBox("ERROR: unable to rename node " & nID & " to " & xID & " (duplicate ID)", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                                    Exit For
                                End If
                                If nc = 0 Then
                                    nodeE.UpgradeOpen()
                                    If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                        If cc = 0 Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                        End If
                                        CLDS_SetLayer(nodeE, pPrefs.l_updt, "Node " & nID)
                                        'nodeE.Layer = pPrefs.l_updt
                                    End If
                                    nc = 1
                                End If
                                CLDS_SetBlockAttr(nodeE, pPrefs.t_node, xID)
                                cc += 1
                            End If
                        End If
                        If p_dialog.cxRNodeArea.Checked And nLayer <> pPrefs.l_dele And InStr(nArea, p_find) > 0 Then
                            iRNodeArea += 1
                            p_dialog.txRNodeArea.Text = Trim(Str$(iRNodeArea))
                            p_dialog.txRNodeArea.Update()
                            If v_replace <> "" Then
                                nArea = Replace(nArea, p_find, v_replace, 1, -1, CompareMethod.Text)
                                If nc = 0 Then
                                    nodeE.UpgradeOpen()
                                    If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                        If cc = 0 Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                        End If
                                        CLDS_SetLayer(nodeE, pPrefs.l_updt, "Node " & nID)
                                        'nodeE.Layer = pPrefs.l_updt
                                    End If
                                    nc = 1
                                End If
                                CLDS_SetBlockAttr(nodeE, pPrefs.t_area, nArea)
                                cc += 1
                            End If
                        End If
                        If p_dialog.cxRSegType.Checked And nLayer <> pPrefs.l_dele And InStr(nType, p_find) > 0 Then
                            iRSegType += 1
                            p_dialog.txRSegType.Text = Trim(Str$(iRSegType))
                            p_dialog.txRSegType.Update()
                            If v_replace <> "" Then
                                nType = Replace(nType, p_find, v_replace, 1, -1, CompareMethod.Text)
                                If nc = 0 Then
                                    nodeE.UpgradeOpen()
                                    If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                        If cc = 0 Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                        End If
                                        CLDS_SetLayer(nodeE, pPrefs.l_updt, "Node " & nID)
                                        'nodeE.Layer = pPrefs.l_updt
                                    End If
                                    nc = 1
                                End If
                                CLDS_SetBlockAttr(nodeE, pPrefs.t_type, nType)
                                cc += 1
                            End If
                        End If
                        If p_dialog.cxRSegSeg.Checked And nLayer <> pPrefs.l_dele And InStr(nSeg, p_find) > 0 Then
                            iRSegSeg += 1
                            p_dialog.txRSegSeg.Text = Trim(Str$(iRSegSeg))
                            p_dialog.txRSegSeg.Update()
                            If v_replace <> "" Then
                                nSeg = Replace(nSeg, p_find, v_replace, 1, -1, CompareMethod.Text)
                                If nc = 0 Then
                                    nodeE.UpgradeOpen()
                                    If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                        If cc = 0 Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                        End If
                                        CLDS_SetLayer(nodeE, pPrefs.l_updt, "Node " & nID)
                                        'nodeE.Layer = pPrefs.l_updt
                                    End If
                                    nc = 1
                                End If
                                CLDS_SetBlockAttr(nodeE, pPrefs.t_seg, nSeg)
                                cc += 1
                            End If
                        End If
                        If p_dialog.cxRSegID.Checked And nLayer <> pPrefs.l_dele And InStr(sID, p_find) > 0 Then
                            iRSegID += 1
                            p_dialog.txRSegID.Text = Trim(Str$(iRSegID))
                            p_dialog.txRSegID.Update()
                            If v_replace <> "" Then
                                sID = Replace(sID, p_find, v_replace, 1, -1, CompareMethod.Text)
                                If nc = 0 Then
                                    nodeE.UpgradeOpen()
                                    If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                        If cc = 0 Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                        End If
                                        CLDS_SetLayer(nodeE, pPrefs.l_updt, "Node " & nID)
                                        'nodeE.Layer = pPrefs.l_updt
                                    End If
                                    nc = 1
                                End If
                                cc += 1
                            End If
                        End If
                        If p_dialog.cxRSegRwID.Checked And nLayer <> pPrefs.l_dele And InStr(nRWay, p_find) > 0 Then
                            iRSegRwID += 1
                            p_dialog.txRSegRwID.Text = Trim(Str$(iRSegRwID))
                            p_dialog.txRSegRwID.Update()
                            If v_replace <> "" Then
                                nRWay = Replace(nRWay, p_find, v_replace, 1, -1, CompareMethod.Text)
                                If nc = 0 Then
                                    nodeE.UpgradeOpen()
                                    If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                        If cc = 0 Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                        End If
                                        CLDS_SetLayer(nodeE, pPrefs.l_updt, "Node " & nID)
                                        ' nodeE.Layer = pPrefs.l_updt
                                    End If
                                    nc = 1
                                End If
                                cc += 1
                            End If
                        End If
                        If nc > 0 Then
                            CLDS_SetBlockXRec(nTrans, nodeE, nID, nType, nSeg, nLen, sID, nRWay, nMajor)
                        End If
                    Next
                End If

                If e And Not lpsr.Value Is Nothing Then
                    p_dialog.pbFind.Minimum = 0
                    p_dialog.pbFind.Maximum = lpsr.Value.Count
                    p_dialog.pbFind.Value = 0
                    p_dialog.pbFind.Visible = True
                    Dim nc As Integer
                    Dim nl As Integer = 0
                    For Each lineID As ObjectId In lpsr.Value.GetObjectIds
                        nl += 1
                        p_dialog.pbFind.Value = nl
                        Dim lineE As Line = DirectCast(lineID.GetObject(OpenMode.ForRead), Line)
                        Dim r1 As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                        Dim n1 As String = "", n2 As String = ""
                        If Not r1 Is Nothing Then
                            Dim t1 As TypedValue() = r1.AsArray
                            n1 = t1(0).Value : n2 = t1(1).Value
                            If n1 <> n2 Then
                                Dim nType As String = t1(2).Value
                                Dim nSeg As String = t1(3).Value
                                If nType = pPrefs.n_jump Then
                                    nSeg = ""
                                End If
                                Dim nLen As String = t1(4).Value
                                Dim nArea As String = "-"
                                Dim nRWay As String = ""
                                Dim sID As String = "-"
                                If t1.Length > 5 Then
                                    sID = t1(5).Value
                                End If
                                If t1.Length > 6 Then
                                    nRWay = t1(6).Value
                                End If
                                Dim nLayer As String = lineE.Layer
                                nc = 0
                                Dim x1 As String = n1
                                Dim x2 As String = n2
                                If v_nooffr Then
                                    If p_dialog.cxRNodeID.Checked And nLayer <> pPrefs.l_dele And InStr(n1, p_find) > 0 Then
                                        If v_replace <> "" Then
                                            x1 = Replace(n1, p_find, v_replace, 1, -1, CompareMethod.Text)
                                            nc = 1
                                            cc += 1
                                        End If
                                    End If
                                Else
                                    If ((nType = pPrefs.n_offr And p_dialog.cxRDevID.Checked) Or (nType <> pPrefs.n_offr And p_dialog.cxRNodeID.Checked)) And nLayer <> pPrefs.l_dele And InStr(n1, p_find) > 0 Then
                                        If v_replace <> "" Then
                                            x1 = Replace(n1, p_find, v_replace, 1, -1, CompareMethod.Text)
                                            nc = 1
                                            cc += 1
                                        End If
                                    End If
                                End If
                                If p_dialog.cxRNodeID.Checked And nLayer <> pPrefs.l_dele And InStr(n2, p_find) > 0 Then
                                    If v_replace <> "" Then
                                        x2 = Replace(n2, p_find, v_replace, 1, -1, CompareMethod.Text)
                                        nc = 1
                                        cc += 1
                                    End If
                                End If
                                If p_dialog.cxRSegType.Checked And nType <> pPrefs.n_offr And nLayer <> pPrefs.l_dele And InStr(nType, p_find) > 0 Then
                                    iRSegType += 1
                                    p_dialog.txRSegType.Text = Trim(Str$(iRSegType))
                                    p_dialog.txRSegType.Update()
                                    If v_replace <> "" Then
                                        nType = Replace(nType, p_find, v_replace, 1, -1, CompareMethod.Text)
                                        nc = 1
                                        cc += 1
                                    End If
                                End If
                                If p_dialog.cxRSegID.Checked And nType <> pPrefs.n_offr And nLayer <> pPrefs.l_dele And InStr(sID, p_find) > 0 Then
                                    iRSegID += 1
                                    p_dialog.txRSegID.Text = Trim(Str$(iRSegID))
                                    p_dialog.txRSegID.Update()
                                    If v_replace <> "" Then
                                        sID = Replace(sID, p_find, v_replace, 1, -1, CompareMethod.Text)
                                        nc = 1
                                        cc += 1
                                    End If
                                End If
                                If p_dialog.cxRSegSeg.Checked And nType <> pPrefs.n_offr And nLayer <> pPrefs.l_dele And InStr(nSeg, p_find) > 0 Then
                                    iRSegSeg += 1
                                    p_dialog.txRSegSeg.Text = Trim(Str$(iRSegSeg))
                                    p_dialog.txRSegRwID.Update()
                                    If v_replace <> "" Then
                                        nSeg = Replace(nSeg, p_find, v_replace, 1, -1, CompareMethod.Text)
                                        nc = 1
                                        cc += 1
                                    End If
                                End If
                                If p_dialog.cxRSegRwID.Checked And nType <> pPrefs.n_offr And nLayer <> pPrefs.l_dele And InStr(nRWay, p_find) > 0 Then
                                    iRSegRwID += 1
                                    p_dialog.txRSegRwID.Text = Trim(Str$(iRSegRwID))
                                    p_dialog.txRSegRwID.Update()
                                    If v_replace <> "" Then
                                        nRWay = Replace(nRWay, p_find, v_replace, 1, -1, CompareMethod.Text)
                                        nc = 1
                                        cc += 1
                                    End If
                                End If
                                If nc > 0 Then
                                    lineE.UpgradeOpen()
                                    If Not (x1 = n1 And x2 = n2) Then
                                        e = CLDS_RenameEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Segment_Key(n1, n2), CLDS_Static_Utils.CLDS_Segment_Key(x1, x2))
                                        If Not e Then
                                            MsgBox("ERROR: unable to rename segment " & n1 & ":" & n2 & " to " & x1 & ":" & x2 & " (duplicate ID)", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                                            Exit For
                                        End If
                                    End If
                                    If Not ((v_nooffr And nType = pPrefs.n_offr) Or nLayer = pPrefs.l_isrt Or nLayer = pPrefs.l_updt) Then
                                        If cc = 0 Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                        End If
                                        CLDS_SetLayer(lineE, pPrefs.l_updt, "Segment " & n1 & ":" & n2)
                                        'lineE.Layer = pPrefs.l_updt
                                    End If
                                    CLDS_SetLineXRec(nTrans, lineE, x1, x2, nType, nSeg, nLen, sID, nRWay)
                                End If
                            End If
                        End If
                    Next
                End If
                If e And Not dpsr.Value Is Nothing Then
                    p_dialog.pbFind.Minimum = 0
                    p_dialog.pbFind.Maximum = dpsr.Value.Count
                    p_dialog.pbFind.Value = 0
                    p_dialog.pbFind.Visible = True
                    Dim nc As Integer
                    Dim nd As Integer = 0
                    For Each devID As ObjectId In dpsr.Value.GetObjectIds
                        nd += 1
                        p_dialog.pbFind.Value = nd
                        Dim devE As BlockReference = DirectCast(devID.GetObject(OpenMode.ForRead), BlockReference)
                        Dim dID As String = CLDS_GetBlockAttr(devE, pPrefs.t_dvce)
                        If dID <> "" Then
                            Dim nArea As String = CLDS_GetBlockAttr(devE, pPrefs.t_area)
                            Dim nLayer As String = devE.Layer
                            nc = 0
                            If p_dialog.cxRDevID.Checked And nLayer <> pPrefs.l_dele And InStr(dID, p_find) > 0 Then
                                iRDevID += 1
                                p_dialog.txRDevID.Text = Trim(Str$(iRDevID))
                                p_dialog.txRDevID.Update()
                                If v_replace <> "" Then
                                    Dim xID As String = Replace(dID, p_find, v_replace, 1, -1, CompareMethod.Text)
                                    e = CLDS_RenameEntry(doc.Database, nTrans, CLDS_Static_Utils.CLDS_Node_Key(dID), CLDS_Static_Utils.CLDS_Node_Key(xID))
                                    If Not e Then
                                        MsgBox("ERROR: unable to rename device " & dID & " to " & xID & " (duplicate ID)", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                                        Exit For
                                    End If
                                    If nc = 0 Then
                                        devE.UpgradeOpen()
                                        If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                            If cc = 0 Then
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                            End If
                                            CLDS_SetLayer(devE, pPrefs.l_updt, "Device " & dID)
                                            'devE.Layer = pPrefs.l_updt
                                        End If
                                        nc = 1
                                    End If
                                    CLDS_SetBlockAttr(devE, pPrefs.t_dvce, xID)
                                    cc += 1
                                End If
                            End If
                            If p_dialog.cxRDevArea.Checked And nLayer <> pPrefs.l_dele And InStr(nArea, p_find) > 0 Then
                                iRDevArea += 1
                                p_dialog.txRDevArea.Text = Trim(Str$(iRDevArea))
                                p_dialog.txRDevArea.Update()
                                If v_replace <> "" Then
                                    nArea = Replace(nArea, p_find, v_replace, 1, -1, CompareMethod.Text)
                                    If nc = 0 Then
                                        devE.UpgradeOpen()
                                        If nLayer <> pPrefs.l_isrt And nLayer <> pPrefs.l_updt Then
                                            If cc = 0 Then
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_updt, pPrefs.c_updt)
                                            End If
                                            CLDS_SetLayer(devE, pPrefs.l_updt, "Device " & dID)
                                            'devE.Layer = pPrefs.l_updt
                                        End If
                                        nc = 1
                                    End If
                                    CLDS_SetBlockAttr(devE, pPrefs.t_area, nArea)
                                    cc += 1
                                End If
                            End If
                        End If
                    Next
                End If
                nTrans.Commit()
            End Using
        End Using
        p_dialog.pbFind.Visible = False
    End Sub
#End Region
#Region "Upload via API"
    Public Sub ShowLogCLOB(ByVal ed As Editor, ByVal p_context As String, ByVal p_id As String, ByVal p_txbox As TextBox)
        Dim larr As String(,)
        Dim lcc As Collection
        Dim r As Integer = CLDS_Query(ed, 1, p_context, "LG", p_id, larr, lcc)
        If r > 0 Then
            For x As Integer = 1 To r - 1
                If p_txbox.Text = "" Then
                    p_txbox.Text = larr(lcc("LG_TEXT"), x)
                Else
                    p_txbox.Text = p_txbox.Text & Environment.NewLine & larr(lcc("LG_TEXT"), x)
                End If
            Next
            p_txbox.Update()
        End If
    End Sub
    Public Function CLDS_ActionAPI(ByVal p_dialog As CLDS_Network_Container, p_source As String, Optional ByVal p_context As String = "DWG") As String
        Dim doc As Document
        Dim ed As Editor
        doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor

        p_dialog.txLog.Visible = True
        p_dialog.txLog.Text = ""
        p_dialog.txLog.Update()

        p_dialog.lbUpload.Visible = True
        p_dialog.lbUpload.Text = "Connecting..."
        p_dialog.lbUpload.Update()

        If CMAPI Is Nothing Then
            p_dialog.lbUpload.Text = "Connection failed"
            p_dialog.lbUpload.Update()
            CLDS_ActionAPI = "ERROR"
            Exit Function
        End If
        p_dialog.lbStatus.Text = "Connected"
        p_dialog.lbStatus.Update()
        'Dim id As String = pProps.v_source
        Dim id As String = p_source
        id = "SOURCE=""" & id & """"
        'id = "SOURCE=""" & "ANALYZE" & """"
        Dim arr As String(,)
        Dim cc As Collection
        p_dialog.lbUpload.Text = "Starting CMPIC batch ..."
        p_dialog.lbUpload.Update()
        Dim r As Integer = CLDS_Query(ed, 1, p_context, "GO", id, arr, cc)
        Dim j As String = ""
        If r > 0 Then
            j = Trim(arr(cc("GO_INO"), 1))
            If Left(UCase(j), 2) = "OK" Then
                j = Trim(Mid(j, InStr(j, ":") + 1))
            Else
                p_dialog.lbStatus.Text = j
                p_dialog.lbStatus.Update()
                r = 0
            End If
        End If
        If pPrefs.x_rfsh = 0 Then
            Return j
        End If
        If r > 0 Then
            p_dialog.txLog.Visible = True
            p_dialog.txLog.Text = ""
            p_dialog.txLog.Update()
            p_dialog.lbUpload.Visible = True
            p_dialog.lbUpload.Text = "Job: " & j
            p_dialog.lbUpload.Update()
            p_dialog.pbSync.Visible = True
            p_dialog.pbSync.MarqueeAnimationSpeed = 100
            p_dialog.pbSync.Minimum = 0
            p_dialog.pbSync.Maximum = 10000
            p_dialog.pbSync.Style = Windows.Forms.ProgressBarStyle.Marquee
            p_dialog.pbSync.Update()
            id = id & " JOB=""" & j & """"
            Dim rps As Integer = Math.Round((1000.0 / pPrefs.x_rfsh), 0)
            For i As Integer = 1 To pPrefs.x_timo * rps
                Thread.Sleep(pPrefs.x_rfsh)
                p_dialog.pbSync.Value = i
                If i Mod rps = 0 Then
                    Dim zcc As Collection
                    Dim zarr As String(,)
                    r = CLDS_Query(ed, 1, p_context, "GO", id, zarr, zcc)
                    If r <= 0 Then
                        If r < 0 Then
                            j = CMERR
                        End If
                        Exit For
                    End If
                    j = CLDS_TrimString(zarr(zcc("GO_INO"), 1))
                    p_dialog.lbUpload.Text = j
                    p_dialog.lbUpload.Update()
                    If Left(UCase(j), 5) = "ERROR" Then
                        Exit For
                    End If
                    If j = "0" Then
                        j = "ERROR: Problem scheduling job (returned zero job number)"
                        p_dialog.lbUpload.Text = j
                        p_dialog.lbUpload.Update()
                        Exit For
                    End If
                    If Left(UCase(j), 8) = "COMPLETE" Then
                        If InStr(UCase(j), "ERROR:") > 0 Then
                            p_dialog.lbUpload.Text = "ERROR"
                            p_dialog.lbUpload.Update()
                            p_dialog.txLog.Text = CLDS_DisplayString(j) & Environment.NewLine
                        End If
                        ShowLogCLOB(ed, p_context, id, p_dialog.txLog)
                        Exit For
                    End If
                End If
            Next
        End If
        p_dialog.pbSync.Style = Windows.Forms.ProgressBarStyle.Blocks
        p_dialog.pbSync.Update()
        p_dialog.pbSync.Visible = False
        ed.WriteMessage(vbLf & j & vbLf)
        CLDS_ActionAPI = j
    End Function
    Public Sub CLDS_Upload(ByVal p_dialog As CLDS_Network_Container, Optional ByVal p_context As String = "DWG")
        Dim doc As Document
        Dim ed As Editor
        Dim npsr As PromptSelectionResult, lpsr As PromptSelectionResult, dpsr As PromptSelectionResult
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        p_dialog.lbUpload.Text = ""
        p_dialog.lbUpload.Update()
        p_dialog.txLog.Text = ""
        p_dialog.ttNetwork.SetToolTip(p_dialog.lbUpload, "")
        p_dialog.txLog.Update()
        If Not CLDS_ValidateNetwork(p_dialog, False) Then
            MsgBox("ERROR: problems with drawing prevent upload", MsgBoxStyle.Exclamation, "CMPIC upload")
            Exit Sub
        End If
        If Not CLDS_DrawingSaved() Then
            MsgBox("WARNING: Please save drawing before uploading", MsgBoxStyle.Exclamation, "CMPIC upload")
            Exit Sub
        End If
        If CMAPI Is Nothing Then
            p_dialog.lbUpload.Text = "ERROR: not connected to CMPIC"
            p_dialog.lbUpload.Update()
            Exit Sub
        End If
        Dim analyze As Boolean = p_dialog.rbDestAnalyze.Checked
        If analyze Then
            Dim again As MsgBoxResult = MsgBoxResult.Ok
            Dim a As String
            Do While again = MsgBoxResult.Ok
                a = CLDS_ActionAPI(p_dialog, "ANALYZE")
                If InStr(UCase(a), "ERROR") > 0 Then
                    again = MsgBox(a & Chr(10) & Chr(10) & "Try again?", MsgBoxStyle.OkCancel, "CMPIC AutoCAD")
                Else
                    again = MsgBoxResult.Cancel
                End If
            Loop
            If InStr(UCase(a), "ERROR") > 0 Then
                MsgBox(a, MsgBoxStyle.Critical, "CMPIC")
                p_dialog.lbUpload.Text = "Analysis result: ERROR"
                p_dialog.lbUpload.Update()
            Else
                p_dialog.lbUpload.Text = "Analysis result: OK"
                p_dialog.lbUpload.Update()
            End If
            Exit Sub
        End If

        If pProps.v_source = "" Then
            pProps.v_source = Microsoft.VisualBasic.FileIO.FileSystem.GetName(Application.DocumentManager.MdiActiveDocument.Name)
            CMAPI.CMSource = pProps.v_source
        End If
        Dim nn As Integer = 0, ns As Integer = 0, nd As Integer = 0
        Dim bnu As Boolean = p_dialog.rbDestBNU.Checked
        p_dialog.lbUpload.Visible = True
        p_dialog.lbUpload.Text = "Initialising..."
        p_dialog.lbUpload.Update()
        bUCSWCS = False
        Dim errors As Integer = 0
        Dim maxerrors As Integer = pPrefs.x_maxe
        If maxerrors < 0 Then
            maxerrors = 9999999
        End If
        Dim fatal As Integer = 0
        Using acLckDoc As DocumentLock = doc.LockDocument()
            Using nTrans As Transaction = doc.TransactionManager.StartTransaction
                If p_dialog.rbScopeUpdates.Checked Then
                    npsr = CLDS_SelectPendingNodes(ed)
                    lpsr = CLDS_SelectPendingSegments(ed)
                    dpsr = CLDS_SelectPendingDevices(ed)
                Else
                    npsr = CLDS_XSelectAllNodes(nTrans, ed)
                    lpsr = CLDS_XSelectAllSegments(nTrans, ed)
                    dpsr = CLDS_XSelectAllDevices(nTrans, ed)
                End If
                CLDS_SetOrigin(nTrans)
                Dim a As String
                Dim xml As System.IO.StreamWriter
                If bnu Then
                    a = CMAPI.SubmitNode("-")
                    If InStr(UCase(a), "NO RULE APPLICATION FOUND") > 0 Then
                        MsgBox(a, MsgBoxStyle.Critical, "CMPIC")
                        p_dialog.lbUpload.Text = a
                        p_dialog.lbUpload.Update()
                        nTrans.Abort()
                        Exit Sub
                    ElseIf InStr(UCase(a), "UNABLE TO CONNECT TO THE REMOTE SERVER") > 0 Then
                        MsgBox(a, MsgBoxStyle.Critical, "CMPIC")
                        p_dialog.lbUpload.Text = a
                        p_dialog.lbUpload.Update()
                        nTrans.Abort()
                        Exit Sub
                    Else
                        p_dialog.lbUpload.Text = "Batch initialise: " & a
                        p_dialog.lbUpload.Update()
                    End If
                Else
                    xml = XML_Open(pProps.v_source)
                End If
                Dim deletions As Collection = New Collection
                If Not npsr.Value Is Nothing Then
                    nn = npsr.Value.Count
                    If errors < maxerrors Then
                        p_dialog.lbUpload.Text = "Checking " + Trim(Str$(nn)) + " nodes..."
                        p_dialog.lbUpload.Update()
                    End If
                    For Each nodeID As ObjectId In npsr.Value.GetObjectIds
                        If errors > maxerrors Then
                            Exit For
                        End If
                        Dim nodeE As BlockReference = DirectCast(nodeID.GetObject(OpenMode.ForRead), BlockReference)
                        Dim nID As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_node)
                        Dim idChanged As Boolean = False
                        If nID <> "" Then
                            Dim nAction As String = nodeE.Layer
                            Dim xAction As String = "-"
                            If nAction = pPrefs.l_dele Then
                                nAction = "D"
                                xAction = "D"
                                deletions.Add(CLDS_Static_Utils.CLDS_Node_Key(nID, nRule))
                            ElseIf nAction = pPrefs.l_isrt Then
                                nAction = "I"
                            Else
                                nAction = "U"
                            End If
                            Dim xp As Point3d = nodeE.Position
                            Dim nx As Double = (xp.X - X_LOCAL) / pPrefs.x_fact
                            Dim ny As Double = (xp.Y - Y_LOCAL) / pPrefs.x_fact
                            If Math.Abs(A_LOCAL) > 0 Then
                                Dim sinA As Double = Math.Sin(A_LOCAL * Math.PI / -180.0)
                                Dim cosA As Double = Math.Cos(A_LOCAL * Math.PI / -180.0)
                                Dim tx As Double = (nx * cosA) - (ny * sinA)
                                Dim ty As Double = (nx * sinA) + (ny * cosA)
                                nx = tx
                                ny = ty
                            End If
                            nx = nx + X_CMPIC
                            ny = ny + Y_CMPIC
                            Dim x As String = Trim(Str$(System.Math.Round(nx, 3)))
                            Dim y As String = Trim(Str$(System.Math.Round(ny, 3)))
                            Dim z As String = Trim(Str$(System.Math.Round((xp.Z / pPrefs.x_fact), 3)))
                            Dim nType As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_type)
                            Dim nArea As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_area)
                            ' Dim nRmk As String = "From " & pProps.v_source
                            Dim nRmk As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_comm)
                            If Len(nRmk) > 60 Then
                                nRmk = Mid$(nRmk, 1, 57) & "..."
                            End If
                            If nRmk = "" Then
                                nRmk = "-"
                            End If
                            Dim nSeg As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_seg)
                            If nType = pPrefs.n_jump Then
                                nSeg = ""
                            End If
                            'If nAction <> "I" Then
                            'nRmk = ""
                            'End If
                            Dim r1 As ResultBuffer = CLDS_GetXRecord(nTrans, nodeE)
                            Dim nMajor As String = "-"
                            If Not r1 Is Nothing Then
                                Dim t1 As TypedValue() = r1.AsArray
                                If t1.Length > 7 Then
                                    nMajor = t1(7).Value
                                End If
                            End If
                            'p_dialog.lbUpload.Text = "Node " & nID & "..."
                            'p_dialog.lbUpload.Update()
                            Dim r As String = ""
                            If bnu Then
                                r = CMAPI.SubmitNode(nID, xAction, 0, "PENDING", CMAPI.CMApplicability, x, y, z, nArea, nRmk, nMajor)
                            Else
                                XML_SubmitNode(xml, nID, xAction, 0, CMAPI.CMApplicability, x, y, z, nArea, nRmk, nMajor)
                            End If
                            If InStr(r, "ERROR:") > 0 Then
                                ed.WriteMessage(vbLf & "Node: " & nID & " " & r)
                                Dim el As String = CLDS_ErrorLayer(pPrefs.l_eror, r, nAction)
                                CLDS_CheckLayer(nTrans, doc, el, pPrefs.c_eror)
                                nodeE.UpgradeOpen()
                                CLDS_SetLayer(nodeE, el, "Node " & nID)
                                'nodeE.Layer = el
                                errors += 1
                            End If
                        End If
                    Next
                End If

                If Not npsr.Value Is Nothing Then
                    nn = npsr.Value.Count
                    p_dialog.lbUpload.Text = "Checking " + Trim(Str$(nn)) + " point-segments..."
                    p_dialog.lbUpload.Update()
                    For Each nodeID As ObjectId In npsr.Value.GetObjectIds
                        If errors > maxerrors Then
                            Exit For
                        End If
                        Dim nodeE As BlockReference = DirectCast(nodeID.GetObject(OpenMode.ForRead), BlockReference)
                        Dim nID As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_node)
                        Dim nType As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_type)
                        Dim idChanged As Boolean = False
                        If nID <> "" And nType <> "" Then
                            Dim nAction As String = nodeE.Layer
                            Dim xAction As String = "-"
                            If nAction = pPrefs.l_dele Then
                                nAction = "D"
                                xAction = "D"
                                deletions.Add(CLDS_Static_Utils.CLDS_Node_Key(nID, nRule))
                            ElseIf nAction = pPrefs.l_isrt Then
                                nAction = "I"
                            Else
                                nAction = "U"
                            End If
                            Dim nArea As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_area)
                            Dim nSeg As String = CLDS_GetBlockAttr(nodeE, pPrefs.t_seg)
                            If nType = pPrefs.n_jump Then
                                nSeg = ""
                            End If
                            Dim o As String = ""
                            If nSeg <> "" Then
                                o = " SEGREGATION=""" & nSeg & """"
                            End If
                            If pPrefs.x_pfil Then
                                o = o & " PARTFILE = """ & pProps.v_source & """"
                            End If
                            o = Trim(o)
                            Dim sID As String = nID
                            If Len(sID) > 20 Then
                                sID = Mid$(sID, 1, 20)
                            End If
                            Dim r1 As ResultBuffer = CLDS_GetXRecord(nTrans, nodeE)
                            Dim nLen As String = pPrefs.x_psln
                            Dim nRWay As String = ""
                            Dim nMajor As String = "-"
                            If r1 Is Nothing Then
                                idChanged = True
                            Else
                                Dim t1 As TypedValue() = r1.AsArray
                                nLen = t1(4).Value
                                If t1.Length > 5 Then
                                    sID = t1(5).Value
                                End If
                                If t1.Length > 6 Then
                                    nRWay = t1(6).Value
                                End If
                                If t1.Length > 7 Then
                                    nMajor = t1(7).Value
                                End If
                            End If
                            If nAction = "I" Then
                                If Len(sID) > 1 And Left$(sID, 1) = "-" Then
                                    sID = Mid$(sID, 2)
                                    idChanged = True
                                ElseIf sID = "-" Or sID = "" Then
                                    sID = nID
                                    idChanged = True
                                End If
                            Else
                                sID = "-"
                            End If
                            If nRWay <> "" And nRWay <> "-" And tokens("PD_YNRWAY") = "Y" Then
                                o = o & " RACEWAYID = """ & nRWay & """"
                            End If
                            'p_dialog.lbUpload.Text = "Point-segment " & nID & "..."
                            'p_dialog.lbUpload.Update()
                            Dim r As String = ""
                            If xAction = "I" And (nType = "" Or nType = "-") Then
                                r = "ERROR: point-segment type not specified"
                            Else
                                If bnu Then
                                    r = CMAPI.SubmitSegment(nID, nID, sID, xAction, 0, "PENDING", CMAPI.CMApplicability, nType, nLen, "-", o)
                                Else
                                    XML_SubmitSegment(xml, nID, nID, sID, xAction, nAction, 0, CMAPI.CMApplicability, nType, nLen, "-", nRWay, nSeg)
                                End If
                            End If
                            If InStr(r, "ERROR:") > 0 Then
                                ed.WriteMessage(vbLf & "Point-segment: " & nID & " " & r)
                                Dim el As String = CLDS_ErrorLayer(pPrefs.l_eror, r, nAction)
                                CLDS_CheckLayer(nTrans, doc, el, pPrefs.c_eror)
                                nodeE.UpgradeOpen()
                                CLDS_SetLayer(nodeE, el, "Node " & nID)
                                'nodeE.Layer = el
                                errors += 1
                            Else
                                If idChanged Then
                                    nodeE.UpgradeOpen()
                                    CLDS_SetBlockXRec(nTrans, nodeE, nID, nType, nSeg, nLen, sID, nRWay, nMajor)
                                End If
                            End If
                        End If
                    Next
                End If

                Dim dnn As System.Collections.Generic.Dictionary(Of String, String) = New System.Collections.Generic.Dictionary(Of String, String)
                If Not lpsr.Value Is Nothing Then
                    ns = lpsr.Value.Count
                    p_dialog.lbUpload.Text = "Checking " + Trim(Str$(ns)) + " segments..."
                    p_dialog.lbUpload.Update()
                    For Each lineID As ObjectId In lpsr.Value.GetObjectIds
                        If errors > maxerrors Then
                            Exit For
                        End If
                        Dim lineE As Line = DirectCast(lineID.GetObject(OpenMode.ForRead), Line)
                        Dim r1 As ResultBuffer = CLDS_GetXRecord(nTrans, lineE)
                        Dim n1 As String = "", n2 As String = ""
                        Dim idChanged As Boolean = False
                        If Not r1 Is Nothing Then
                            Dim t1 As TypedValue() = r1.AsArray
                            n1 = t1(0).Value : n2 = t1(1).Value
                            If n1 = n2 Then
                                lineE.UpgradeOpen()
                                lineE.Erase()
                            Else
                                Dim nAction As String = lineE.Layer
                                Dim xAction As String = "-"
                                If nAction = pPrefs.l_dele Then
                                    nAction = "D"
                                    xAction = "D"
                                    deletions.Add(CLDS_Static_Utils.CLDS_Segment_Key(n1, n2))
                                ElseIf nAction = pPrefs.l_isrt Then
                                    nAction = "I"
                                ElseIf nAction = pPrefs.l_brek Then
                                    nAction = "B"
                                    xAction = "D"
                                    deletions.Add(CLDS_Static_Utils.CLDS_Segment_Key(n1, n2))
                                Else
                                    nAction = "U"
                                End If
                                Dim nType As String = t1(2).Value
                                Dim nLen As String = t1(4).Value
                                If nType = "OFFROUTE" Then
                                    If Not dnn.ContainsKey(n1) Then
                                        dnn.Add(n1, n2 & "#" & nLen)
                                    Else
                                        dnn(n1) = dnn(n1) & "," & n2 & "#" & nLen
                                    End If
                                Else
                                    Dim nSeg As String = t1(3).Value
                                    If nType = pPrefs.n_jump Then
                                        nSeg = ""
                                    End If
                                    Dim nArea As String = "-"
                                    Dim nRWay As String = ""
                                    Dim sID As String = "-"
                                    If t1.Length > 5 Then
                                        sID = t1(5).Value
                                    End If
                                    If nAction = "I" Then
                                        If Len(sID) > 1 And Left$(sID, 1) = "-" Then
                                            sID = Mid$(sID, 2)
                                            idChanged = True
                                        End If
                                    Else
                                        sID = "-"
                                    End If
                                    If t1.Length > 6 Then
                                        nRWay = t1(6).Value
                                    End If
                                    Dim o As String = ""
                                    If nSeg <> "" Then
                                        o = o & " SEGREGATION=""" & nSeg & """"
                                    End If
                                    If nRWay <> "" And nRWay <> "-" And tokens("PD_YNRWAY") = "Y" Then
                                        o = o & " RACEWAYID=""" & nRWay & """"
                                    End If
                                    If pPrefs.x_pfil Then
                                        o = o & " PARTFILE = """ & pProps.v_source & """"
                                    End If

                                    o = Trim(o)
                                    'p_dialog.lbUpload.Text = "Segment  " & n1 & ":" & n2 & "..."
                                    'p_dialog.lbUpload.Update()
                                    Dim r As String
                                    If xAction = "I" And (nType = "" Or nType = "-") Then
                                        r = "ERROR: segment type not specified"
                                    Else
                                        If bnu Then
                                            r = CMAPI.SubmitSegment(n1, n2, sID, xAction, 0, "PENDING", CMAPI.CMApplicability, nType, nLen, "-", o)
                                        Else
                                            XML_SubmitSegment(xml, n1, n2, sID, xAction, nAction, 0, CMAPI.CMApplicability, nType, nLen, "-", nRWay, nSeg)
                                        End If
                                    End If
                                    If InStr(r, "ERROR:") > 0 Then
                                        ed.WriteMessage(vbLf & "Segment: " & n1 & " " & n2 & " " & r)
                                        Dim el As String = CLDS_ErrorLayer(pPrefs.l_eror, r, nAction)
                                        CLDS_CheckLayer(nTrans, doc, el, pPrefs.c_eror)
                                        lineE.UpgradeOpen()
                                        CLDS_SetLayer(lineE, el, "Segment " & n1 & ":" & n2)
                                        'lineE.Layer = el
                                        errors += 1
                                    Else
                                        If idChanged Then
                                            lineE.UpgradeOpen()
                                            CLDS_SetLineXRec(nTrans, lineE, n1, n2, nType, nSeg, nLen, sID, nRWay)
                                        End If
                                        If nAction = "B" Then
                                            Dim rb As ResultBuffer = CLDS_GetBreakXRecord(nTrans, lineE)
                                            If Not rb Is Nothing Then
                                                Dim dd As DBDictionary = CLDS_GetDictionary(doc.Database, nTrans, False)
                                                Dim bt As BlockTable = DirectCast(nTrans.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                                                Dim btr As BlockTableRecord = DirectCast(nTrans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                                                Dim ra As TypedValue() = rb.AsArray
                                                For i As Integer = 0 To ra.Length
                                                    Dim b1 As String
                                                    Dim b2 As String
                                                    If i = 0 Then
                                                        b1 = n1
                                                    Else
                                                        b1 = ra(i - 1).Value
                                                    End If
                                                    If i = ra.Length Then
                                                        b2 = n2
                                                    Else
                                                        b2 = ra(i).Value
                                                    End If
                                                    Dim no1 As ObjectId, no2 As ObjectId
                                                    no1 = CLDS_FindNode(nTrans, dd, b1)
                                                    no2 = CLDS_FindNode(nTrans, dd, b2)
                                                    If Not (no1.IsNull Or no2.IsNull) Then
                                                        Dim nb1 As BlockReference = DirectCast(nTrans.GetObject(no1, OpenMode.ForRead), BlockReference)
                                                        Dim nb2 As BlockReference = DirectCast(nTrans.GetObject(no2, OpenMode.ForRead), BlockReference)
                                                        Dim l As Double
                                                        Dim sl As Line = Nothing
                                                        If bnu Then
                                                            sl = New Line(nb1.Position, nb2.Position)
                                                            sl.Thickness = pPrefs.x_lint
                                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_isrt, pPrefs.c_isrt, False)
                                                            If nType = pPrefs.n_jump Then
                                                                CLDS_SetLayer(lineE, pPrefs.l_jump, "Segment " & b1 & ":" & b2)
                                                                'sl.Layer = pPrefs.l_jump
                                                            Else
                                                                CLDS_SetLayer(lineE, pPrefs.l_sgmt, "Segment " & b1 & ":" & b2)
                                                                'sl.Layer = pPrefs.l_sgmt
                                                            End If
                                                            sl.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
                                                            sl.Thickness = pPrefs.x_lint
                                                            btr.AppendEntity(sl)
                                                            nTrans.AddNewlyCreatedDBObject(sl, True)
                                                            l = Math.Round((sl.Length / pPrefs.x_fact), 3)
                                                        Else
                                                            l = nb1.Position.DistanceTo(nb2.Position)
                                                            l = Math.Round((l / pPrefs.x_fact), 3)
                                                        End If
                                                        nLen = Trim(Str$(l))
                                                        nArea = n1 & "@" & n2
                                                        If bnu Then
                                                            r = CMAPI.SubmitSegment(b1, b2, "-", "I", 0, "PENDING", CMAPI.CMApplicability, nType, nLen, nArea, o)
                                                        Else
                                                            XML_SubmitSegment(xml, b1, b2, "-", "I", "I", 0, CMAPI.CMApplicability, nType, nLen, nArea, nRWay, nSeg)
                                                        End If
                                                        If InStr(r, "ERROR:") > 0 Then
                                                            ed.WriteMessage(vbLf & "Segment: " & b1 & " " & b2 & " " & r)
                                                            Dim el As String = CLDS_ErrorLayer(pPrefs.l_eror, r, nAction)
                                                            CLDS_CheckLayer(nTrans, doc, el, pPrefs.c_eror)
                                                            lineE.UpgradeOpen()
                                                            CLDS_SetLayer(lineE, el, "Segment " & b1 & ":" & b2)
                                                            'lineE.Layer = el
                                                            sl.Erase()
                                                            errors += 1
                                                        ElseIf bnu Then
                                                            CLDS_AddSegment(nTrans, dd, b1, b2, nType, nSeg, nLen, sl.ObjectId, "-", nRWay)
                                                        End If
                                                    End If
                                                Next
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    Next
                End If
                If Not dpsr.Value Is Nothing Then
                    nd = dpsr.Value.Count
                    p_dialog.lbUpload.Text = "Checking " + Trim(Str$(nd)) + " devices..."
                    p_dialog.lbUpload.Update()
                    For Each devID As ObjectId In dpsr.Value.GetObjectIds
                        If errors > maxerrors Then
                            Exit For
                        End If
                        Dim devE As BlockReference = DirectCast(devID.GetObject(OpenMode.ForRead), BlockReference)
                        Dim dID As String = CLDS_GetBlockAttr(devE, pPrefs.t_dvce)
                        If dID <> "" Then
                            Dim nAction As String = devE.Layer
                            Dim xAction As String = "-"
                            If nAction = pPrefs.l_dele Then
                                nAction = "D"
                                xAction = "D"
                            ElseIf nAction = pPrefs.l_isrt Then
                                nAction = "I"
                            Else
                                nAction = "U"
                            End If
                            Dim xp As Point3d = devE.Position
                            Dim nx As Double = (xp.X - X_LOCAL) / pPrefs.x_fact
                            Dim ny As Double = (xp.Y - Y_LOCAL) / pPrefs.x_fact
                            If Math.Abs(A_LOCAL) > 0 Then
                                Dim sinA As Double = Math.Sin(A_LOCAL * Math.PI / -180.0)
                                Dim cosA As Double = Math.Cos(A_LOCAL * Math.PI / -180.0)
                                Dim tx As Double = (nx * cosA) - (ny * sinA)
                                Dim ty As Double = (nx * sinA) + (ny * cosA)
                                nx = tx
                                ny = ty
                            End If
                            nx = nx + X_CMPIC
                            ny = ny + Y_CMPIC
                            Dim x As String = Trim(Str$(System.Math.Round(nx, 3)))
                            Dim y As String = Trim(Str$(System.Math.Round(ny, 3)))
                            Dim z As String = Trim(Str$(System.Math.Round((xp.Z / pPrefs.x_fact), 3)))
                            Dim nArea As String = CLDS_GetBlockAttr(devE, pPrefs.t_area)
                            'Dim dRmk As String = "From " & pProps.v_source
                            'If Len(dRmk) > 60 Then
                            'dRmk = Mid$(dRmk, 1, 57) & "..."
                            'End If
                            ' Dim dRmk As String = ""
                            Dim dRmk As String = CLDS_GetBlockAttr(devE, pPrefs.t_comm)
                            If Len(dRmk) > 60 Then
                                dRmk = Mid$(dRmk, 1, 57) & "..."
                            End If
                            If dRmk = "" Then
                                dRmk = "-"
                            End If
                            Dim o As String = ""
                            o = o & "X=""" & x & """ Y=""" & y & """ Z=""" & z & """"
                            If dnn.ContainsKey(dID) Then
                                o = o & " DEVICENODE=""" & Replace(dnn(dID), "#", "@@", 1, -1, CompareMethod.Text) & """"
                            End If
                            'p_dialog.lbUpload.Text = "Device " & dID & "..."
                            'p_dialog.lbUpload.Update()
                            Dim r As String
                            If bnu Then
                                r = CMAPI.SubmitDevice(dID, xAction, 0, "PENDING", CMAPI.CMApplicability, "-", "-", nArea, "-", "-", dRmk, o)
                            Else
                                XML_SubmitDevice(xml, dID, xAction, 0, CMAPI.CMApplicability, nArea, dRmk, pProps.v_source, x, y, z, o)
                            End If
                            If InStr(r, "ERROR:") > 0 Then
                                ed.WriteMessage(vbLf & "Device: " & dID & " " & r)
                                Dim el As String = CLDS_ErrorLayer(pPrefs.l_eror, r, nAction)
                                CLDS_CheckLayer(nTrans, doc, el, pPrefs.c_eror)
                                devE.UpgradeOpen()
                                CLDS_SetLayer(devE, el, "Device " & dID)
                                'devE.Layer = el
                                errors += 1
                            End If
                        End If
                    Next
                End If
                If errors > maxerrors Then
                    MsgBox("Maximum " & Trim(Str$(maxerrors)) & " errors exceeded", MsgBoxStyle.Critical, "CMPIC AutoCAD")
                    p_dialog.lbUpload.Text = "API result: ERROR"
                    p_dialog.lbUpload.Update()
                ElseIf (nn + ns + nd) > 0 Then
                    If bnu Then
                        Dim again As MsgBoxResult = MsgBoxResult.Ok
                        Do While again = MsgBoxResult.Ok
                            a = CLDS_ActionAPI(p_dialog, pProps.v_source, p_context)
                            If InStr(UCase(a), "ERROR") > 0 Then
                                again = MsgBox(a & Chr(10) & Chr(10) & "Try again?", MsgBoxStyle.OkCancel, "CMPIC AutoCAD")
                            Else
                                again = MsgBoxResult.Cancel
                            End If
                        Loop
                        If InStr(UCase(a), "ERROR") > 0 Then
                            MsgBox(a, MsgBoxStyle.Critical, "CMPIC")
                            p_dialog.lbUpload.Text = "BNU result: ERROR"
                            p_dialog.lbUpload.Update()
                        Else
                            p_dialog.lbUpload.Text = "BNU result: OK" & IIf((errors > 0), " (ignored " & Str$(errors) & " " & IIf((errors > 1), "errors", "error") & ")", "")
                            p_dialog.lbUpload.Update()
                            If Not npsr.Value Is Nothing Then
                                For Each nodeID As ObjectId In npsr.Value.GetObjectIds
                                    Dim nodeE As BlockReference = DirectCast(nodeID.GetObject(OpenMode.ForWrite), BlockReference)
                                    If nodeE.Layer = pPrefs.l_dele Then
                                        nodeE.Erase()
                                    Else
                                        Dim r1 As ResultBuffer = CLDS_GetXRecord(nTrans, nodeE)
                                        Dim nMajor As String = "N"
                                        Dim t1 As TypedValue() = r1.AsArray
                                        If t1.Length > 7 Then
                                            nMajor = t1(7).Value
                                        End If
                                        If nMajor = "Y" Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_nodm, pPrefs.c_nodm)
                                            CLDS_SetLayer(nodeE, pPrefs.l_nodm, "Node")
                                            'nodeE.Layer = pPrefs.l_nodm
                                        Else
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_node, pPrefs.c_node)
                                            CLDS_SetLayer(nodeE, pPrefs.l_node, "Node")
                                            'nodeE.Layer = pPrefs.l_node
                                        End If
                                    End If
                                Next
                            End If
                            If Not dpsr.Value Is Nothing Then
                                For Each devID As ObjectId In dpsr.Value.GetObjectIds
                                    Dim devE As BlockReference = DirectCast(devID.GetObject(OpenMode.ForWrite), BlockReference)
                                    If devE.Layer = pPrefs.l_dele Then
                                        devE.Erase()
                                    Else
                                        CLDS_CheckLayer(nTrans, doc, pPrefs.l_dvce, pPrefs.c_dvce)
                                        CLDS_SetLayer(devE, pPrefs.l_dvce, "Device")
                                        'devE.Layer = pPrefs.l_dvce
                                    End If
                                Next
                            End If
                            If Not lpsr.Value Is Nothing Then
                                For Each lineID As ObjectId In lpsr.Value.GetObjectIds
                                    Dim lineE As Line = DirectCast(lineID.GetObject(OpenMode.ForWrite), Line)
                                    If lineE.Layer = pPrefs.l_dele Or lineE.Layer = pPrefs.l_brek Then
                                        lineE.Erase()
                                    Else
                                        Dim sp As CLDS_Segment_Properties = CLDS_GetSegmentProps(lineID)
                                        If sp Is Nothing Then
                                            CLDS_CheckLayer(nTrans, doc, pPrefs.l_sgmt, pPrefs.c_sgmt)
                                            CLDS_SetLayer(lineE, pPrefs.l_sgmt, "Segment")
                                            'lineE.Layer = pPrefs.l_sgmt
                                        Else
                                            If sp.Type = pPrefs.n_jump Then
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_jump, pPrefs.c_jump)
                                                CLDS_SetLayer(lineE, pPrefs.l_jump, "Segment")
                                                'lineE.Layer = pPrefs.l_jump
                                            ElseIf sp.Type = pPrefs.n_offr Then
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_offr, pPrefs.c_offr)
                                                CLDS_SetLayer(lineE, pPrefs.l_offr, "Segment")
                                                'lineE.Layer = pPrefs.l_offr
                                            Else
                                                CLDS_CheckLayer(nTrans, doc, pPrefs.l_sgmt, pPrefs.c_sgmt)
                                                CLDS_SetLayer(lineE, pPrefs.l_sgmt, "Segment")
                                                'lineE.Layer = pPrefs.l_sgmt
                                            End If
                                        End If
                                    End If
                                Next
                            End If
                            If deletions.Count > 0 Then
                                CLDS_RemoveEntries(doc.Database, nTrans, deletions)
                            End If
                        End If
                    Else
                        XML_Close(xml, p_dialog)
                    End If
                Else
                    p_dialog.lbUpload.Text = "No changes"
                    p_dialog.lbUpload.Update()
                End If
                nTrans.Commit()
            End Using
        End Using
        If bnu Then
            ed.Regen()
            Autodesk.AutoCAD.ApplicationServices.Application.UpdateScreen()
        End If
    End Sub
#End Region
#Region "XML support"
    Public Function XML_Open(ByVal p_source As String) As System.IO.StreamWriter
        Dim Xml As System.IO.StreamWriter = Nothing
        Dim dwg As String = p_source
        If Right(dwg, 4) = ".dwg" Then
            dwg = Mid(dwg, 1, Len(dwg) - 4)
        End If
        Dim f As String = pPrefs.r_xmlf
        Dim d As String = pPrefs.r_xmld
        Dim n As DateTime = DateTime.Now
        d = n.ToString(d)
        f = Replace(f, "{dwg}", dwg, 1, -1, CompareMethod.Text)
        f = Replace(f, "{date}", d, 1, -1, CompareMethod.Text)
        f = Environment.ExpandEnvironmentVariables(f)
        Try
            Xml = New System.IO.StreamWriter(f)
        Catch ex As IOException
            MsgBox("Unable to open output XML file " & f & Chr(10) & ex.Message, MsgBoxStyle.Critical, "CMPIC XML Generator")
            Xml = Nothing
        End Try
        If Not Xml Is Nothing Then
            Xml.WriteLine("<?xml version=""1.0"" encoding=""UTF-8""?>")
            Xml.WriteLine("<CMPIC_API SourceID=""" & p_source & """ xmlns=""http://www.cloudis.com"">")
        End If
        Return Xml
    End Function
    Public Sub XML_SubmitNode(ByVal fXML As System.IO.StreamWriter, _
                              ByVal nID As String, _
                              ByVal xAction As String, _
                              ByVal nINO As Long, _
                              ByVal pAppl As String, _
                              ByVal x As String, ByVal y As String, ByVal z As String, _
                              ByVal nArea As String, _
                              ByVal nRmk As String, _
                              ByVal nMajor As String)
        If fXML Is Nothing Then
            Exit Sub
        End If
        fXML.WriteLine("<Node ID=""" & nID & """ Action=""" & xAction & """>")
        fXML.WriteLine("  <Applicability>" & pAppl & "</Applicability>")
        fXML.WriteLine("  <Coordinates X=""" & x & """ Y=""" & y & """ Z=""" & z & """ />")
        fXML.WriteLine("  <Area>" & nArea & "</Area>")
        fXML.WriteLine("  <IsMajor>" & nMajor & "</IsMajor>")
        fXML.WriteLine("</Node>")
    End Sub
    Public Sub XML_SubmitSegment(ByVal fXML As System.IO.StreamWriter, _
                                 ByVal n1ID As String, _
                                 ByVal n2ID As String, _
                                 ByVal sID As String, _
                                 ByVal xAction As String, _
                                 ByVal nAction As String, _
                                 ByVal sINO As Long, _
                                 ByVal sAppl As String, _
                                 ByVal nType As String, _
                                 ByVal nLen As String, _
                                 ByVal nArea As String, _
                                 ByVal nRWay As String, _
                                 ByVal sSeg As String)
        If fXML Is Nothing Then
            Exit Sub
        End If
        fXML.WriteLine("<Segment ID=""" & sID & """ Action=""" & xAction & """>")
        fXML.WriteLine("  <Applicability>" & sAppl & "</Applicability>")
        fXML.WriteLine("  <FNode>" & n1ID & "</FNode>")
        fXML.WriteLine("  <TNode>" & n2ID & "</TNode>")
        fXML.WriteLine("  <NRType>" & nType & "</NRType>")
        fXML.WriteLine("  <Length>" & nLen & "</Length>")
        fXML.WriteLine("  <Span>" & "0" & "</Span>")
        If nRWay <> "" And nRWay <> "-" And tokens("PD_YNRWAY") = "Y" Then
            fXML.WriteLine("  <RacewayID>" & nRWay & "</RacewayID>")
        End If
        If sSeg <> "" And sSeg <> "-" Then
            fXML.WriteLine("  <Segregations>")
            fXML.WriteLine("    <Segregation Code=""" & sSeg & """/>")
            fXML.WriteLine("  </Segregations>")
        End If
        fXML.WriteLine("</Segment>")
    End Sub
    Public Sub XML_SubmitDevice(ByVal fXML As System.IO.StreamWriter, _
                                ByVal dID As String, _
                                ByVal xAction As String, _
                                ByVal dINO As Long, _
                                ByVal dAppl As String, _
                                ByVal nArea As String, _
                                ByVal dRmk As String, _
                                ByVal dDwg As String, _
                                ByVal dX As String, ByVal dY As String, ByVal dZ As String, _
                                Optional ByVal dNodes As String = "")
        If fXML Is Nothing Then
            Exit Sub
        End If
        fXML.WriteLine("<Device ID=""" & dID & """ Action=""" & xAction & """>")
        fXML.WriteLine("  <Applicability>" & dAppl & "</Applicability>")
        fXML.WriteLine("  <System>" & "-" & "</System>")
        fXML.WriteLine("  <Description>" & "-" & "</Description>")
        fXML.WriteLine("  <Coordinates X=""" & dX & """ Y=""" & dY & """ Z=""" & dZ & """ />")
        fXML.WriteLine("  <Area>" & nArea & "</Area>")
        If InStr(dNodes, "DEVICENODE=") > 0 Then
            Dim vNodes As String = Replace(Replace(Mid$(dNodes, InStr(dNodes, "DEVICENODE=") + Len("DEVICENODE=")), """", ""), "@@", "#")
            Dim dns() As String = Split(vNodes, ",", -1, CompareMethod.Binary)
            fXML.WriteLine("  <DeviceNodes>")
            For Each dn As String In dns
                Dim dnd() As String = Split(dn, "#", -1, CompareMethod.Text)
                fXML.WriteLine("    <DeviceNode NodeID=""" & dnd(0) & """ OffRouteLength=""" & dnd(1) & """ />")
            Next
            fXML.WriteLine("  </DeviceNodes>")
        End If
        'fXML.WriteLine("  <PartID_3D>" & dDwg & "</PartID_3D>")
        'If dRmk <> "" Then
        'fXML.WriteLine("  <Remarks>" & dRmk & "</Remarks>")
        'End If
        fXML.WriteLine("</Device>")
    End Sub
    Public Sub XML_Close(ByVal fXML As System.IO.StreamWriter, Optional ByVal p_dialog As CLDS_Network_Container = Nothing)
        If fXML Is Nothing Then
            Exit Sub
        End If
        fXML.WriteLine("</CMPIC_API>")
        Dim fs As FileStream = DirectCast(fXML.BaseStream, FileStream)
        MsgBox("XML output to " & fs.Name, MsgBoxStyle.Information, "CMPIC XML Output")
        If Not p_dialog Is Nothing Then
            p_dialog.lbUpload.Text = "Writing to XML file " & Chr(10) & fs.Name
            p_dialog.ttNetwork.SetToolTip(p_dialog.lbUpload, fs.Name)
            p_dialog.lbUpload.Update()
        End If
        fXML.Close()
    End Sub
#End Region
#Region "Palette and dialog handling"
    Public Sub CLDS_RouteDialog(Optional ByVal p_cabid As String = "", _
                                Optional ByVal p_ps As Autodesk.AutoCAD.Windows.PaletteSet = Nothing, _
                                Optional ByVal p_sd As CLDS_Segment_Container = Nothing)
        Dim ps As Autodesk.AutoCAD.Windows.PaletteSet = Nothing
        If p_ps Is Nothing Then
            ps = p_palette
        Else
            ps = p_ps
        End If
        Dim f As CLDS_Route_Container = New CLDS_Route_Container
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        f.Initialize(Me, p_sd)
        If p_cabid = "" Or Not p_sd Is Nothing Then
            f.tbCabID.Enabled = True
            f.btExeqry.Visible = True
        Else
            f.tbCabID.Enabled = False
            f.btExeqry.Visible = False
        End If
        f.CRColour = pPrefs.c_crte
        f.btCRColour.BackColor = f.CRColour
        f.ARColour = pPrefs.c_arte
        f.btARColour.BackColor = f.ARColour
        CLDS_RouteCableDetail(f, p_cabid)
        Dim psn As String = "Route"
        Dim j As Integer = 0
        For i As Integer = 1 To ps.Count - 1
            If Left(ps.Item(i).Name, Len(psn)) = psn Then
                j = j + 1
            End If
        Next
        If j > 0 Then
            psn = psn & " [" & (j + 1).ToString & "]"
        End If
        f.PSParent = ps.Add(psn, f)
        If p_ps Is Nothing Then
            ps.Visible = True
        End If
        If p_rtedialog Is Nothing Then
            p_rtedialog = f
        End If
    End Sub
    Private Sub PaletteResizeHandler(ByVal sender As Object, ByVal e As Autodesk.AutoCAD.Windows.PaletteSetSizeEventArgs)
        If p_segdialog Is Nothing Then
            Exit Sub
        End If
        Dim ps As Autodesk.AutoCAD.Windows.PaletteSet = DirectCast(sender, Autodesk.AutoCAD.Windows.PaletteSet)
        Dim pss As System.Drawing.Size = ps.Size
        Dim psd As Boolean
        If ps.Dock.Equals(Autodesk.AutoCAD.Windows.DockSides.None) Then
            psd = False
        Else
            psd = True
        End If
        'Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & psd & " Palette resized " & pss.ToString & vbLf)
        Dim gbs As System.Drawing.Size = p_segdialog.gbCables.Size
        Dim cls As System.Drawing.Size = p_segdialog.lvCables.Size
        Dim tbs As System.Drawing.Size = p_segdialog.tbSegID.Size
        If psd Then
            gbs.Width = pss.Width - 66
        Else
            gbs.Width = pss.Width - 86
        End If
        If gbs.Width < (tbs.Width + 83) Then
            gbs.Width = tbs.Width + 83
        End If
        If psd Then
            gbs.Height = 113
        Else
            gbs.Height = pss.Height - 293
        End If
        If gbs.Height < 113 Then
            gbs.Height = 113
        End If
        p_segdialog.gbCables.Size = gbs
        cls.Width = gbs.Width - 16
        cls.Height = gbs.Height - 18
        p_segdialog.lvCables.Size = cls
        p_segdialog.gbCables.Update()
        p_segdialog.lvCables.Update()
    End Sub
    Private Sub HzPaletteResizeHandler(ByVal sender As Object, ByVal e As Autodesk.AutoCAD.Windows.PaletteSetSizeEventArgs)
        If p_mcbdialog Is Nothing Then
            Exit Sub
        End If
        Dim ps As Autodesk.AutoCAD.Windows.PaletteSet = DirectCast(sender, Autodesk.AutoCAD.Windows.PaletteSet)
        Dim pss As System.Windows.Size
        pss.Width = ps.PaletteSize().Width
        pss.Height = ps.PaletteSize().Height
        Dim psd As Boolean
        If ps.Dock.Equals(Autodesk.AutoCAD.Windows.DockSides.None) Then
            psd = False
        Else
            psd = True
        End If
        'Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & psd & " Palette resized " & pss.ToString & vbLf)
        Dim cls As System.Drawing.Size = p_mcbdialog.lvMultiCable.Size
        cls.Width = pss.Width - 36
        cls.Height = pss.Height - 6
        p_mcbdialog.tpMultiRow.Size = cls
        cls.Width = pss.Width - 56
        cls.Height = pss.Height - 44
        p_mcbdialog.lvMultiCable.Size = cls
        p_mcbdialog.lvMultiSegment.Size = cls
        p_mcbdialog.tpMultiRow.Update()
        p_mcbdialog.lvMultiCable.Update()
        p_mcbdialog.lvMultiSegment.Update()
    End Sub
    Public Sub CLDS_CMPICPalette(ByVal p_dialog As CLDS_Connection_Container, Optional ByVal p_title As String = "CMPIC")
        If p_palette Is Nothing Then
            p_palette = New Autodesk.AutoCAD.Windows.PaletteSet("", p_palguid)
            AddHandler p_palette.SizeChanged, AddressOf PaletteResizeHandler
        End If
        p_palette.Name = p_title
        p_palette.Add("Connection", p_dialog)
        p_palette.Visible = True
        p_palette.MinimumSize = New System.Drawing.Size(320, 400)
    End Sub
    Public Sub CLDS_CMPICPaletteTitle()
        If pConDialog Is Nothing Then
            Exit Sub
        End If
        pPalette.Name = "CMPIC " & pPrefs.x_vstr & " [" & pConDialog.txProjid.Text & "," & pConDialog.cbVFocus.Text & "]"
    End Sub
    Public Sub CLDS_CMPICHzPalette(Optional ByVal p_title As String = "CMPIC")
        If p_hzpalette Is Nothing Then
            p_hzpalette = New Autodesk.AutoCAD.Windows.PaletteSet("", p_hzpalguid)
            AddHandler p_hzpalette.SizeChanged, AddressOf HzPaletteResizeHandler
            p_hzpalette.Name = p_title
            p_mcbdialog = New CLDS_Multirow_Container
            p_mcbdialog.CA = Me
            p_hzpalette.Add("Cables", p_mcbdialog)
            p_hzpalette.Visible = False
            'p_hzpalette.MinimumSize = New System.Drawing.Size(600, 200)
        End If
    End Sub
    Public Sub SavePaletteValues(ByVal p_doc As Document)
        Dim ud As Hashtable = p_doc.UserData
        Dim dd As CLDS_Document_Data
        If ud.Contains(x_udkey) Then
            dd = DirectCast(ud.Item(x_udkey), CLDS_Document_Data)
        Else
            dd = New CLDS_Document_Data
            ud.Add(x_udkey, dd)
        End If
        dd.SaveParameters(p_doc, pConDialog, pNetDialog, pSegDialog, pRouteDialog, p_palette.Visible)
    End Sub
    Public Function CheckPaletteVisible(ByVal p_doc As Document) As Boolean
        Dim ud As Hashtable = p_doc.UserData
        Dim dd As CLDS_Document_Data
        If ud.Contains(x_udkey) Then
            dd = DirectCast(ud.Item(x_udkey), CLDS_Document_Data)
            Return dd.IsVisible
        End If
        Return False
    End Function
    Public Sub RestorePaletteValues(ByVal p_doc As Document)
        Dim ud As Hashtable = p_doc.UserData
        Dim dd As CLDS_Document_Data
        If ud.Contains(x_udkey) Then
            dd = DirectCast(ud.Item(x_udkey), CLDS_Document_Data)
            dd.RestoreParameters(pConDialog, pNetDialog, pSegDialog, pRouteDialog)
        End If
        Me.pNetDialog.tbNCount.Text = ""
        Me.pNetDialog.tbSCount.Text = ""
        Me.pNetDialog.tbDCount.Text = ""
    End Sub
    Public Function HasPaletteValues(ByVal p_doc As Document) As Boolean
        Dim ud As Hashtable = p_doc.UserData
        HasPaletteValues = ud.Contains(x_udkey)
    End Function
    Public Sub RemovePaletteValues()
        Me.pNetDialog.tbNCount.Text = ""
        Me.pNetDialog.tbSCount.Text = ""
        Me.pNetDialog.tbDCount.Text = ""
        Me.pNetDialog.tbDevID.Text = ""
        Me.pNetDialog.ShowDevice()
        Me.pSegDialog.tbSegID.Text = ""
        Me.pSegDialog.tbFromNode.Text = ""
        Me.pSegDialog.tbToNode.Text = ""
        Me.pSegDialog.ShowSegment()
        Me.pRouteDialog.tbCabID.Text = ""
        Me.pRouteDialog.ShowCable()
    End Sub
#End Region
#Region "Event handlers"
    Public Sub NoCMPICDocument()
        If p_palette.Visible Then
            Dim n As Integer = Application.DocumentManager.Count
            Dim c As Document = Application.DocumentManager.MdiActiveDocument
            Dim v As Boolean = False
            For Each d As Document In Application.DocumentManager
                If c <> d Then
                    If HasPaletteValues(d) Then
                        v = True
                    End If
                End If
            Next
            If Not v Then
                p_palette.Visible = False
            End If
        End If
    End Sub
    Public Sub docColDocAct _
        (ByVal senderObj As Object, _
        ByVal docColDocActEvtArgs As DocumentCollectionEventArgs)
        If Not p_currdocs Is Nothing Then
            If Not docColDocActEvtArgs.Document Is Nothing Then
                If docColDocActEvtArgs.Document = p_currdocs Then
                    Exit Sub
                End If
            End If
        End If
        If CheckPaletteVisible(docColDocActEvtArgs.Document) Then
            p_palette.Visible = True
        Else
            If HasPaletteValues(docColDocActEvtArgs.Document) Then
                p_palette.Visible = False
            End If
        End If
        If p_palette.Visible Then
            CLDS_DoCMPIC()
            RestorePaletteValues(docColDocActEvtArgs.Document)
        End If
        AddHandler docColDocActEvtArgs.Document.BeginDocumentClose, AddressOf docColDocClose
        BlockCache = Nothing
        p_currdocs = docColDocActEvtArgs.Document
    End Sub
    Public Sub docColDocDeact _
        (ByVal senderObj As Object, _
        ByVal docColDocActEvtArgs As DocumentCollectionEventArgs)
        If docColDocActEvtArgs.Document Is Nothing Then
            Exit Sub
        End If
        If p_currdocs Is Nothing Then
            Exit Sub
            'SavePaletteValues(docColDocActEvtArgs.Document)
        Else
            If docColDocActEvtArgs.Document = p_currdocs Then
                SavePaletteValues(docColDocActEvtArgs.Document)
            End If
        End If
        ' NoCMPICDocument()
    End Sub
    Public Sub docColDocClose _
        (ByVal senderObj As Object, _
        ByVal docBegClsEvtArgs As DocumentBeginCloseEventArgs)
        p_currdocs = Nothing
        If p_palette Is Nothing Then
            Exit Sub
        End If
        NoCMPICDocument()
    End Sub
#End Region
#Region "Commands"
    <Autodesk.AutoCAD.Runtime.CommandMethod("CLDS_CMPICRegister")> _
     Public Sub CLDS_CMPICRegister()
        DemandLoading.RegistryUpdate.RegisterForDemandLoading()
    End Sub
    <Autodesk.AutoCAD.Runtime.CommandMethod("CLDS_CMPICUnregister")> _
     Public Sub CLDS_CMPICUnregister()
        DemandLoading.RegistryUpdate.UnregisterForDemandLoading()
    End Sub
    <Autodesk.AutoCAD.Runtime.CommandMethod("CLDS_Encrypt")> _
    Public Sub CLDS_DoEncrypt()
        Dim pso As PromptStringOptions = New PromptStringOptions(vbLf & "Enter string to encrypt: ")
        pso.AllowSpaces = True
        Dim psr As PromptResult = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.GetString(pso)
        If psr.Status = PromptStatus.OK Then
            If psr.StringResult = "" Then
                Exit Sub
            End If
            Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "[" & CLDS_Encrypt(psr.StringResult) & "]")
        End If
    End Sub
    Public Sub CLDS_SaveCMPIC()
        Dim doc As Document
        doc = Application.DocumentManager.MdiActiveDocument
        SavePaletteValues(doc)
    End Sub
    Public Sub CLDS_RestoreCMPIC()
        Dim doc As Document
        doc = Application.DocumentManager.MdiActiveDocument
        If HasPaletteValues(doc) Then
            RestorePaletteValues(doc)
        Else
            MsgBox("CMPIC dialog values not available", MsgBoxStyle.Exclamation, "CMPIC AutoCAD")
        End If
    End Sub
    <Autodesk.AutoCAD.Runtime.CommandMethod("CLDS_CMPIC")> _
    Public Sub CLDS_DoCMPIC()
        If p_palette Is Nothing Then
            Dim d As String = pPrefs.r_xmld
            Dim n As DateTime = DateTime.Now
            d = n.ToString(d)
            Dim tracef As String = Environment.ExpandEnvironmentVariables("%TEMP%\CLDS_ACAD_" & d & ".log")
            System.Diagnostics.Trace.Listeners.Add(New TextWriterTraceListener(tracef, "CLDS_ACAD_Listener"))
        End If
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim id As String = Microsoft.VisualBasic.FileIO.FileSystem.GetName(doc.Name)
        Dim p As New CLDS_Drawing_Properties, z As CLDS_Drawing_Properties
        p.v_file = doc.Name & ".xml"
        z = p.LoadProperties()
        If z Is Nothing Then
            If Not p_palette Is Nothing Then
                p_palette.Visible = False
                SavePaletteValues(doc)
            End If
            Exit Sub
        End If
        Me.pProps = p
        pPrefs.LoadPreferences()
        CLDS_DropConnection()
        Dim x As Boolean = CLDS_URLConnection(True)
        If Not x Or CMAPI Is Nothing Then
            ed.WriteMessage(vbLf & "Unable to connect to CMPIC")
            System.Diagnostics.Trace.TraceError("Unable to connect to CMPIC")
            System.Diagnostics.Trace.Flush()
            If Not p_palette Is Nothing Then
                p_palette.Visible = False
            End If
            Exit Sub
        End If
        CLDS_GetProjectDefaults()
        If tokens.Count = 0 Then
            If Not p_palette Is Nothing Then
                p_palette.Visible = False
            End If
            Exit Sub
        End If
        If p_palette Is Nothing Then
            Dim c As CLDS_Connection_Container = New CLDS_Connection_Container
            c.Initialize(Me)
            c.lbConnStatus.Text = "Connected"
            c.PropsToolTip(p.v_file)
            Me.pConDialog = c
            CLDS_CMPICPalette(c, "CMPIC " & v_no & " " & v_date)
            pPrefs.x_vist = v_no & " " & v_date
            System.Diagnostics.Trace.TraceInformation("CMPIC AutoCAD interface version " & pPrefs.x_vist)
            Dim n As CLDS_Network_Container = New CLDS_Network_Container
            n.Initialize(Me)
            p_palette.Add("Network", n)
            Me.pNetDialog = n
            Dim s As CLDS_Segment_Container = New CLDS_Segment_Container
            s.Initialize(Me)
            p_palette.Add("Segment", s)
            Me.pSegDialog = s
            CLDS_RouteDialog("", p_palette, s)
            SavePaletteValues(doc)
            AddHandler Application.DocumentManager.DocumentActivated, AddressOf docColDocAct
            AddHandler Application.DocumentManager.DocumentToBeDeactivated, AddressOf docColDocDeact
            AddHandler doc.BeginDocumentClose, AddressOf docColDocClose
        Else
            p_palette.Visible = True
            Me.pConDialog.Initialize(Me)
            Me.pNetDialog.Initialize(Me, Me.pNetDialog.Context, False)
            Me.pSegDialog.Initialize(Me)
            Me.pRouteDialog.Reinitialize(Me)
            'If HasPaletteValues(doc) Then
            'Else
            RemovePaletteValues()
            'End If
        End If
        Dim cCMPIC As Collection = CLDS_GetCMPICVersion()
        If Not cCMPIC Is Nothing Then
            pPrefs.x_vstr = cCMPIC("STRING")
            pPrefs.x_vnum = cCMPIC("NUMBER")
            If pPrefs.x_vnum < 61002 Then
                pPrefs.x_pfil = False
            End If
        End If
        CLDS_CMPICPaletteTitle()
    End Sub
    Public Sub CLDS_ShowProjectPath()
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim pn As String = Application.GetSystemVariable("PROJECTNAME")
        Dim pp As String
        pp = CLDS_Static_Utils.CLDS_ProjectPath(pn)
        CLDS_Static_Utils.CLDS_WriteMessage(ed, "Project path=" & pp)
    End Sub
    Public Sub CLDS_TestFlex()
        Dim doc As Document
        Dim ed As Editor
        doc = Application.DocumentManager.MdiActiveDocument
        ed = doc.Editor
        Dim r As String, v As String
        'nRule = New CLDS_Flex_Format("AAAAXYYYSNNZ")
        'nRule.Prompt("X") = "Side"
        'nRule.Prompt("Y") = "Frame"
        'nRule.Prompt("Z") = "Tray type"
        'r = nRule.Split_Value("6051S106P01G")
        'nRule.Bind("A") = "1234"
        'nRule.Bind("S") = "X"
        'nRule.Bind("X") = "P"
        'nRule.Bind("Y") = "987"
        'nRule.Bind("Z") = "T"
        'v = nRule.Bind_All(66)
        'r = nRule.Prompt_All(ed)
        'v = nRule.Bind_All(77)
        'ed.WriteMessage(vbCrLf & "Result: " & v)
        'nRule = New CLDS_Flex_Format("{AREA}-N{NNNN}")
        nRule = New CLDS_Flex_Format("{ID}")
        nRule.Bind("A") = "1234"
        r = nRule.Prompt_All(ed)
        v = nRule.Bind_All(77)
        ed.WriteMessage(vbCrLf & "Result: " & v)
        nRule = Nothing
    End Sub
#End Region
End Class

